iv class="head">

Theory Prelim

section ‹Preliminaries›

theory Prelim
  imports
    "Fresh_Identifiers.Fresh_String"
    "Bounded_Deducibility_Security.Trivia"
begin


subsection ‹The basic types›

(*  This version of string is needed for code generation: *)
definition "emptyStr = STR ''''"

(* The users of the system: *)


datatype name = Nam String.literal
definition "emptyName ≡ Nam emptyStr"
datatype inform = Info String.literal
definition "emptyInfo ≡ Info emptyStr"

datatype user = Usr name inform
fun nameUser where "nameUser (Usr name info) = name"
fun infoUser where "infoUser (Usr name info) = info"
definition "emptyUser ≡ Usr emptyName emptyInfo"

typedecl raw_data
code_printing type_constructor raw_data ⇀ (Scala) "java.io.File"

(* Images (currently, pdf, to be changed): *)
datatype img  = emptyImg | Imag raw_data
(* Visibility outside the current api: either friends-only or public
 (i.e., exportable outside to the other apis): *)
datatype vis = Vsb String.literal
(* Accepted values: friend and public  *)
abbreviation "FriendV ≡ Vsb (STR ''friend'')"
(* abbreviation "InternalV ≡ Vsb (STR ''internal'')" *)
abbreviation "PublicV ≡ Vsb (STR ''public'')"
fun stringOfVis where "stringOfVis (Vsb str) = str"

(* A post consists of a string for title, a string for its text,
  a (possibly empty) image and a visibility specification: *)

datatype title = Tit String.literal
definition "emptyTitle ≡ Tit emptyStr"
datatype "text" = Txt String.literal
definition "emptyText ≡ Txt emptyStr"

datatype post = Pst title "text" img (* vis *)
(* Getters: *)
fun titlePost where "titlePost (Pst title text img) = title"
fun textPost where "textPost (Pst title text img) = text"
fun imgPost where "imgPost (Pst title text img) = img"
(* fun visPost where "visPost (Pst title text img vis) = vis" *)
(* Setters: *)
fun setTitlePost where "setTitlePost (Pst title text img) title' = Pst title' text img"
fun setTextPost where "setTextPost(Pst title text img) text' = Pst title text' img"
fun setImgPost where "setImgPost (Pst title text img) img' = Pst title text img'"
(* fun setVisPost where "setVisPost (Pst title text img vis) vis' = Pst title text img vis'" *)
(*  *)
definition emptyPost :: post where
"emptyPost ≡ Pst emptyTitle emptyText emptyImg" (*  FriendV" *)
(* initially set to the lowest visibility: friend *)

lemma titlePost_emptyPost[simp]: "titlePost emptyPost = emptyTitle"
and textPost_emptyPost[simp]: "textPost emptyPost = emptyText"
and imgPost_emptyPost[simp]: "imgPost emptyPost = emptyImg"
(* and visPost_emptyPost[simp]: "visPost emptyPost = FriendV" *)
unfolding emptyPost_def by simp_all

lemma set_get_post[simp]:
"titlePost (setTitlePost ntc title) = title"
"titlePost (setTextPost ntc text) = titlePost ntc"
"titlePost (setImgPost ntc img) = titlePost ntc"
(* "titlePost (setVisPost ntc vis) = titlePost ntc" *)
(* *)
"textPost (setTitlePost ntc title) = textPost ntc"
"textPost (setTextPost ntc text) = text"
"textPost (setImgPost ntc img) = textPost ntc"
(* "textPost (setVisPost ntc vis) = textPost ntc" *)
(* *)
"imgPost (setTitlePost ntc title) = imgPost ntc"
"imgPost (setTextPost ntc text) = imgPost ntc"
"imgPost (setImgPost ntc img) = img"
(* "imgPost (setVisPost ntc vis) = imgPost ntc" *)
(* *)
(*
"visPost (setTitlePost ntc title) = visPost ntc"
"visPost (setTextPost ntc text) = visPost ntc"
"visPost (setImgPost ntc img) = visPost ntc"
"visPost (setVisPost ntc vis) = vis"
*)
(* *)
by(cases ntc, auto)+

lemma setTextPost_absorb[simp]:
"setTitlePost (setTitlePost pst tit) tit1 = setTitlePost pst tit1"
"setTextPost (setTextPost pst txt) txt1 = setTextPost pst txt1"
"setImgPost (setImgPost pst img) img1 = setImgPost pst img1"
(* "setVisPost (setVisPost pst vis) vis1 = setVisPost pst vis1" *)
by (cases pst, auto)+

datatype password = Psw String.literal
definition "emptyPass ≡ Psw emptyStr"

datatype salt = Slt String.literal
definition "emptySalt ≡ Slt emptyStr"

(* Information associated to requests for registration: both for users and apis *)
datatype requestInfo = ReqInfo String.literal
definition "emptyRequestInfo ≡ ReqInfo emptyStr"


subsection ‹Identifiers›

datatype apiID = Aid String.literal
datatype userID = Uid String.literal
datatype postID = Pid String.literal

definition "emptyApiID ≡ Aid emptyStr"
definition "emptyUserID ≡ Uid emptyStr"
definition "emptyPostID ≡ Pid emptyStr"

(*  *)
fun apiIDAsStr where "apiIDAsStr (Aid str) = str"

definition "getFreshApiID apiIDs ≡ Aid (fresh (set (map apiIDAsStr apiIDs)) (STR ''1''))"

lemma ApiID_apiIDAsStr[simp]: "Aid (apiIDAsStr apiID) = apiID"
by (cases apiID) auto

lemma member_apiIDAsStr_iff[simp]: "str ∈ apiIDAsStr ` apiIDs ⟷ Aid str ∈ apiIDs"
by (metis ApiID_apiIDAsStr image_iff apiIDAsStr.simps)

lemma getFreshApiID: "¬ getFreshApiID apiIDs ∈∈ apiIDs"
using fresh_notIn[of "set (map apiIDAsStr apiIDs)"] unfolding getFreshApiID_def by auto

(*  *)
fun userIDAsStr where "userIDAsStr (Uid str) = str"

definition "getFreshUserID userIDs ≡ Uid (fresh (set (map userIDAsStr userIDs)) (STR ''2''))"

lemma UserID_userIDAsStr[simp]: "Uid (userIDAsStr userID) = userID"
by (cases userID) auto

lemma member_userIDAsStr_iff[simp]: "str ∈ userIDAsStr ` (set userIDs) ⟷ Uid str ∈∈ userIDs"
by (metis UserID_userIDAsStr image_iff userIDAsStr.simps)

lemma getFreshUserID: "¬ getFreshUserID userIDs ∈∈ userIDs"
using fresh_notIn[of "set (map userIDAsStr userIDs)"] unfolding getFreshUserID_def by auto

(*  *)
fun postIDAsStr where "postIDAsStr (Pid str) = str"

definition "getFreshPostID postIDs ≡ Pid (fresh (set (map postIDAsStr postIDs)) (STR ''3''))"

lemma PostID_postIDAsStr[simp]: "Pid (postIDAsStr postID) = postID"
by (cases postID) auto

lemma member_postIDAsStr_iff[simp]: "str ∈ postIDAsStr ` (set postIDs) ⟷ Pid str ∈∈ postIDs"
by (metis PostID_postIDAsStr image_iff postIDAsStr.simps)

lemma getFreshPostID: "¬ getFreshPostID postIDs ∈∈ postIDs"
using fresh_notIn[of "set (map postIDAsStr postIDs)"] unfolding getFreshPostID_def by auto

end
d>

Theory System_Specification

section ‹The CoSMeDis single node specification›

text ‹This is the specification of a CoSMeDis node, as described
in Sections II and IV.B of \cite{cosmedis-SandP2017}.
NB: What that paper refers to as "nodes" are referred in this formalization
as "APIs".

A CoSMeDis node extends CoSMed \cite{cosmed-itp2016,cosmed-jar2018,cosmed-AFP}
with inter-node communication actions.
›

theory System_Specification
  imports
    Prelim
    "Bounded_Deducibility_Security.IO_Automaton"
begin

text ‹An aspect not handled in this specification is the uniqueness of the node IDs. These
are assumed to be handled externally as follows: a node ID is an URI, and therefore is unique.›

declare List.insert[simp]

subsection ‹The state›

record state =
  admin :: userID
  (*  *)
  pendingUReqs :: "userID list"
  userReq :: "userID ⇒ requestInfo"
  userIDs :: "userID list"
  user :: "userID ⇒ user"
  pass :: "userID ⇒ password"
  (*  *)
  pendingFReqs :: "userID ⇒ userID list"
  friendReq :: "userID ⇒ userID ⇒ requestInfo"
  friendIDs :: "userID ⇒ userID list"
  (* Outer friendship, i.e., friendship with users of other (server) APIs. This will effectively
     mean access to the friend-only outer posts retrieved from that server.
     There are two lists:
      - friendship authorizations sent by users of this API, and
      - friendship authorizations received from other APIs. *)
  sentOuterFriendIDs :: "userID ⇒ (apiID × userID) list"
  recvOuterFriendIDs :: "userID ⇒ (apiID × userID) list"
  (*  *)
  postIDs :: "postID list"
  post :: "postID ⇒ post"
  owner :: "postID ⇒ userID"
  vis :: "postID ⇒ vis"
  (* The server-api IDs represents the apis whose posts can be read by this api. *)
  (* The following setting ensures that clashes on post IDs from different apis are harmless: *)
  (* Pending request sent by this API to other APIs with the wish that they become servers (and the current API
       becomes their client); this has to be approved by the respective APIs *)
  pendingSApiReqs :: "apiID list"
  sApiReq :: "apiID ⇒ requestInfo"
  serverApiIDs :: "apiID list"
  (* Password (key) to be used (by both parties) for communication with each server API. *)
  serverPass :: "apiID ⇒ password"
  outerPostIDs :: "apiID ⇒ postID list"
  outerPost :: "apiID ⇒ postID ⇒ post"
  outerOwner :: "apiID ⇒ postID ⇒ userID"
  outerVis :: "apiID ⇒ postID ⇒ vis"
  (*  *)
  (* The client-api IDs represents the apis that can read this api's posts *)
  (* Pending requests from APIs that want to become clients; this has to be approved by the admin *)
  pendingCApiReqs :: "apiID list"
  cApiReq :: "apiID ⇒ requestInfo"
  clientApiIDs :: "apiID list"
  (* Password (key) to be used (by both parties) for communication with each client API. *)
  clientPass :: "apiID ⇒ password"
  sharedWith :: "postID ⇒ (apiID × bool) list"
  (* for a post, stores the client apis with which the post was shared together with a boolean flag
     indicating whether the version the api has is up-to-date *)

(* The api IDs will be the URLs of the corresponding APIs *)
(* Note that only the client APIs need a password -- the server API are themselves contacted by this API. *)

(* Note that IDsOK refers only to the registered users, posts, server APIs and their served outerPosts,
and client apis. It does not refer to user IDs or api IDs contained in any pending requests.
*)
definition IDsOK :: "state ⇒ userID list ⇒ postID list ⇒ (apiID × postID list) list ⇒ apiID list ⇒ bool"
where
"IDsOK s uIDs pIDs saID_pIDs_s caIDs ≡
 list_all (λ uID. uID ∈∈ userIDs s) uIDs ∧
 list_all (λ pID. pID ∈∈ postIDs s) pIDs ∧
 list_all (λ (aID,pIDs). aID ∈∈ serverApiIDs s ∧
 list_all (λ pID. pID ∈∈ outerPostIDs s aID) pIDs) saID_pIDs_s ∧
 list_all (λ aID. aID ∈∈ clientApiIDs s) caIDs"


subsection ‹The actions›

subsubsection ‹Initialization of the system›


definition istate :: state
where
"istate ≡
 ⦇
  admin = emptyUserID,

  pendingUReqs = [],
  userReq = (λ uID. emptyRequestInfo),
  userIDs = [],
  user = (λ uID. emptyUser),
  pass = (λ uID. emptyPass),

  pendingFReqs = (λ uID. []),
  friendReq = (λ uID uID'. emptyRequestInfo),
  friendIDs = (λ uID. []),

  sentOuterFriendIDs = (λ uID. []),
  recvOuterFriendIDs = (λ uID. []),

  postIDs = [],
  post = (λ papID. emptyPost),
  owner = (λ pID. emptyUserID),
  vis = (λ pID. FriendV),

  pendingSApiReqs = [],
  sApiReq = (λ aID. emptyRequestInfo),
  serverApiIDs = [],
  serverPass = (λ aID. emptyPass),
  outerPostIDs = (λ aID. []),
  outerPost = (λ aID papID. emptyPost),
  outerOwner = (λ aID papID. emptyUserID),
  outerVis = (λ aID pID. FriendV),

  pendingCApiReqs = [],
  cApiReq = (λ aID. emptyRequestInfo),
  clientApiIDs = [],
  clientPass = (λ aID. emptyPass),
  sharedWith = (λpID. [])
 ⦈"


subsubsection ‹Starting action›

(* This initiates the current api. It has the following parameters:
  -- uID, p, name: the admin user id, name and password
*)
definition startSys ::
"state ⇒ userID ⇒ password ⇒ state"
where
"startSys s uID p ≡
 s ⦇admin := uID,
    userIDs := [uID],
    user := (user s) (uID := emptyUser),
    pass := (pass s) (uID := p)⦈"

definition e_startSys :: "state ⇒ userID ⇒ password ⇒  bool"
where
"e_startSys s uID p ≡ userIDs s = []"


subsubsection ‹Creation actions›


(* Create new user request: we allow users to choose their own IDs; they could be their email addresses. *)
definition createNUReq :: "state ⇒ userID ⇒ requestInfo ⇒ state"
where
"createNUReq s uID reqInfo ≡
 s ⦇pendingUReqs := pendingUReqs s @ [uID],
    userReq := (userReq s)(uID := reqInfo)
⦈"

definition e_createNUReq :: "state ⇒ userID ⇒ requestInfo ⇒ bool"
where
"e_createNUReq s uID requestInfo ≡
 admin s ∈∈ userIDs s ∧ ¬ uID ∈∈ userIDs s ∧ ¬ uID ∈∈ pendingUReqs s"
(* a new-user request can be created only if the api has started, i.e., if an admin exists *)

(* The admin actually creates a user by approving a pending new-user request.
E.g., the admin can add an  arbitrary password and send it by email to that user.
Then the user can change his password. *)
definition createUser :: "state ⇒ userID ⇒ password ⇒ userID ⇒ password ⇒ state"
where
"createUser s uID p uID' p' ≡
 s ⦇userIDs := uID' # (userIDs s),
    user := (user s) (uID' := emptyUser),
    pass := (pass s) (uID' := p'),
    pendingUReqs := remove1 uID' (pendingUReqs s),
    userReq := (userReq s)(uID := emptyRequestInfo)⦈"

definition e_createUser :: "state ⇒ userID ⇒ password ⇒ userID ⇒ password ⇒ bool"
where
"e_createUser s uID p uID' p' ≡
 IDsOK s [uID] [] [] [] ∧ pass s uID = p ∧ uID = admin s ∧ uID' ∈∈ pendingUReqs s"


(* Create post: note that post ID is an action parameter, and that the enabledness action
checks that it is fresh.
The API's interface will actually generate it, using getFresh. *)
definition createPost :: "state ⇒ userID ⇒ password ⇒ postID ⇒ state"
where
"createPost s uID p pID ≡
 s ⦇postIDs := pID # postIDs s,
    post := (post s) (pID := emptyPost),
    owner := (owner s) (pID := uID)⦈"
(* Recall from the initial state that the initial visibility is FriendV *)

definition e_createPost :: "state ⇒ userID ⇒ password ⇒ postID ⇒ bool"
where
"e_createPost s uID p pID ≡
 IDsOK s [uID] [] [] [] ∧ pass s uID = p ∧
 ¬ pID ∈∈ postIDs s"

(* Friendship: *)
(* Create friend request, namely uID Reqs friendship of uID': *)
definition createFriendReq :: "state ⇒ userID ⇒ password ⇒ userID ⇒ requestInfo ⇒ state"
where
"createFriendReq s uID p uID' req ≡
 let pfr = pendingFReqs s in
 s ⦇pendingFReqs := pfr (uID' := pfr uID' @ [uID]),
    friendReq := fun_upd2 (friendReq s) uID uID' req⦈"

definition e_createFriendReq :: "state ⇒ userID ⇒ password ⇒ userID ⇒ requestInfo ⇒ bool"
where
"e_createFriendReq s uID p uID' req ≡
 IDsOK s [uID,uID'] [] [] [] ∧ pass s uID = p ∧
 ¬ uID ∈∈ pendingFReqs s uID' ∧ ¬ uID ∈∈ friendIDs s uID'"

(* Create friend, by approving a friend request (namely uID approves the request from uID').
Friendship is symmetric, hence the two updates to "friend";
also, the friendship request is canceled upon approval.  *)
definition createFriend :: "state ⇒ userID ⇒ password ⇒ userID ⇒ state"
where
"createFriend s uID p uID' ≡
 let fr = friendIDs s; pfr = pendingFReqs s in
 s ⦇friendIDs := fr (uID := fr uID @ [uID'], uID' := fr uID' @ [uID]),
    pendingFReqs := pfr (uID := remove1 uID' (pfr uID), uID' := remove1 uID (pfr uID')),
    friendReq := fun_upd2 (fun_upd2 (friendReq s) uID' uID emptyRequestInfo) uID uID' emptyRequestInfo⦈"

definition e_createFriend :: "state ⇒ userID ⇒ password ⇒ userID ⇒ bool"
where
"e_createFriend s uID p uID' ≡
 IDsOK s [uID,uID'] [] [] [] ∧ pass s uID = p ∧
 uID' ∈∈ pendingFReqs s uID"


subsubsection ‹Deletion (removal) actions›

(* Delete friend:   *)
definition deleteFriend :: "state ⇒ userID ⇒ password ⇒ userID ⇒ state"
where
"deleteFriend s uID p uID' ≡
 let fr = friendIDs s in
 s ⦇friendIDs := fr (uID := removeAll uID' (fr uID), uID' := removeAll uID (fr uID'))⦈"


definition e_deleteFriend :: "state ⇒ userID ⇒ password ⇒ userID ⇒ bool"
where
"e_deleteFriend s uID p uID' ≡
 IDsOK s [uID,uID'] [] [] [] ∧ pass s uID = p ∧
 uID' ∈∈ friendIDs s uID"


subsubsection ‹Updating actions›

(* Users can update their passwords and names: *)
definition updateUser :: "state ⇒ userID ⇒ password ⇒ password ⇒ name ⇒ inform ⇒ state"
where
"updateUser s uID p p' name info ≡
 s ⦇user := (user s) (uID := Usr name info),
    pass := (pass s) (uID := p')⦈"

definition e_updateUser :: "state ⇒ userID ⇒ password ⇒ password ⇒ name ⇒ inform ⇒ bool"
where
"e_updateUser s uID p p' name info ≡
 IDsOK s [uID] [] [] [] ∧ pass s uID = p"

definition updatePost :: "state ⇒ userID ⇒ password ⇒ postID ⇒ post ⇒ state"
where
"updatePost s uID p pID pst ≡
 let sW = sharedWith s in
 s ⦇post := (post s) (pID := pst),
    sharedWith := sW (pID := map (λ (aID,_). (aID,False)) (sW pID))⦈"

definition e_updatePost :: "state ⇒ userID ⇒ password ⇒ postID ⇒ post ⇒ bool"
where
"e_updatePost s uID p pID pst ≡
 IDsOK s [uID] [pID] [] [] ∧ pass s uID = p ∧
 owner s pID = uID"

definition updateVisPost :: "state ⇒ userID ⇒ password ⇒ postID ⇒ vis ⇒ state"
where
"updateVisPost s uID p pID vs ≡
 s ⦇vis := (vis s) (pID := vs)⦈"

definition e_updateVisPost :: "state ⇒ userID ⇒ password ⇒ postID ⇒ vis ⇒ bool"
where
"e_updateVisPost s uID p pID vs ≡
 IDsOK s [uID] [pID] [] [] ∧ pass s uID = p ∧
 owner s pID = uID ∧ vs ∈ {FriendV, PublicV}"

(* Note: Of course, the outer posts cannot be updated from this API. *)


subsubsection ‹Reading actions›

(* Read new user request: *)
definition readNUReq :: "state ⇒ userID ⇒ password ⇒ userID ⇒ requestInfo"
where
"readNUReq s uID p uID' ≡ userReq s uID'"

definition e_readNUReq :: "state ⇒ userID ⇒ password ⇒ userID ⇒ bool"
where
"e_readNUReq s uID p uID' ≡
 IDsOK s [uID] [] [] [] ∧ pass s uID = p ∧
 uID = admin s ∧ uID' ∈∈ pendingUReqs s"

(* A user can read their name (and so can all the other users), but not the password: *)
definition readUser :: "state ⇒ userID ⇒ password ⇒ userID ⇒ name"
where
"readUser s uID p uID' ≡ nameUser (user s uID')"

definition e_readUser :: "state ⇒ userID ⇒ password ⇒ userID ⇒ bool"
where
"e_readUser s uID p uID' ≡
 IDsOK s [uID,uID'] [] [] [] ∧ pass s uID = p"

(* A user can check if he is the admin: *)
definition readAmIAdmin :: "state ⇒ userID ⇒ password ⇒ bool"
where
"readAmIAdmin s uID p ≡ uID = admin s"

definition e_readAmIAdmin :: "state ⇒ userID ⇒ password ⇒ bool"
where
"e_readAmIAdmin s uID p ≡
 IDsOK s [uID] [] [] [] ∧ pass s uID = p"

(* Reading posts: *)

definition readPost :: "state ⇒ userID ⇒ password ⇒ postID ⇒ post"
where
"readPost s uID p pID ≡ post s pID"

definition e_readPost :: "state ⇒ userID ⇒ password ⇒ postID ⇒ bool"
where
"e_readPost s uID p pID ≡
 IDsOK s [uID] [pID] [] [] ∧ pass s uID = p ∧
 (owner s pID = uID ∨ uID ∈∈ friendIDs s (owner s pID) ∨ vis s pID = PublicV)"

definition readOwnerPost :: "state ⇒ userID ⇒ password ⇒ postID ⇒ userID"
where
"readOwnerPost s uID p pID ≡ owner s pID"

definition e_readOwnerPost :: "state ⇒ userID ⇒ password ⇒ postID ⇒ bool"
where
"e_readOwnerPost s uID p pID ≡
 IDsOK s [uID] [pID] [] [] ∧ pass s uID = p ∧
 (admin s = uID ∨ owner s pID = uID ∨ uID ∈∈ friendIDs s (owner s pID) ∨ vis s pID = PublicV)"

definition readVisPost :: "state ⇒ userID ⇒ password ⇒ postID ⇒ vis"
where
"readVisPost s uID p pID ≡ vis s pID"

definition e_readVisPost :: "state ⇒ userID ⇒ password ⇒ postID ⇒ bool"
where
"e_readVisPost s uID p pID ≡
 IDsOK s [uID] [pID] [] [] ∧ pass s uID = p ∧
 (admin s = uID ∨ owner s pID = uID ∨ uID ∈∈ friendIDs s (owner s pID) ∨ vis s pID = PublicV)"

(* Reading outer posts: *)

definition readOPost :: "state ⇒ userID ⇒ password ⇒ apiID ⇒ postID ⇒ post"
where
"readOPost s uID p aID pID ≡ outerPost s aID pID"

definition e_readOPost :: "state ⇒ userID ⇒ password ⇒ apiID ⇒ postID ⇒ bool"
where
"e_readOPost s uID p aID pID ≡
 IDsOK s [uID] [] [(aID,[pID])] [] ∧ pass s uID = p ∧
 (admin s = uID ∨ (aID,outerOwner s aID pID) ∈∈ recvOuterFriendIDs s uID ∨ outerVis s aID pID = PublicV)"

definition readOwnerOPost :: "state ⇒ userID ⇒ password ⇒ apiID ⇒ postID ⇒ userID"
where
"readOwnerOPost s uID p aID pID ≡ outerOwner s aID pID"

definition e_readOwnerOPost :: "state ⇒ userID ⇒ password ⇒ apiID ⇒ postID ⇒ bool"
where
"e_readOwnerOPost s uID p aID pID ≡
 IDsOK s [uID] [] [(aID,[pID])] [] ∧ pass s uID = p ∧
 (admin s = uID ∨ (aID,outerOwner s aID pID) ∈∈ recvOuterFriendIDs s uID ∨ outerVis s aID pID = PublicV)"

definition readVisOPost :: "state ⇒ userID ⇒ password ⇒ apiID ⇒ postID ⇒ vis"
where
"readVisOPost s uID p aID pID ≡ outerVis s aID pID"

definition e_readVisOPost :: "state ⇒ userID ⇒ password ⇒ apiID ⇒ postID ⇒ bool"
where
"e_readVisOPost s uID p aID pID ≡
 let post = outerPost s aID pID in
 IDsOK s [uID] [] [(aID,[pID])] [] ∧ pass s uID = p ∧
 (admin s = uID ∨ (aID,outerOwner s aID pID) ∈∈ recvOuterFriendIDs s uID ∨
  outerVis s aID pID = PublicV)"



(* Friendship: *)
(* Read friendship request to me: *)
definition readFriendReqToMe :: "state ⇒ userID ⇒ password ⇒ userID ⇒ requestInfo"
where
"readFriendReqToMe s uID p uID' ≡ friendReq s uID' uID"

definition e_readFriendReqToMe :: "state ⇒ userID ⇒ password ⇒ userID ⇒ bool"
where
"e_readFriendReqToMe s uID p uID' ≡
 IDsOK s [uID,uID'] [] [] [] ∧ pass s uID = p ∧
 uID' ∈∈ pendingFReqs s uID"

(* Read friendship request from me: *)
definition readFriendReqFromMe :: "state ⇒ userID ⇒ password ⇒ userID ⇒ requestInfo"
where
"readFriendReqFromMe s uID p uID' ≡ friendReq s uID uID'"

definition e_readFriendReqFromMe :: "state ⇒ userID ⇒ password ⇒ userID ⇒ bool"
where
"e_readFriendReqFromMe s uID p uID' ≡
 IDsOK s [uID,uID'] [] [] [] ∧ pass s uID = p ∧
 uID ∈∈ pendingFReqs s uID'"

(* Read request posted to a desired server api: *)
definition readSApiReq :: "state ⇒ userID ⇒ password ⇒ apiID ⇒ requestInfo"
where
"readSApiReq s uID p uID' ≡ sApiReq s uID'"

definition e_readSApiReq :: "state ⇒ userID ⇒ password ⇒ apiID ⇒ bool"
where
"e_readSApiReq s uID p uID' ≡
 IDsOK s [uID] [] [] [] ∧ pass s uID = p ∧
 uID = admin s ∧ uID' ∈∈ pendingSApiReqs s"

(* Read request from possible client api: *)
definition readCApiReq :: "state ⇒ userID ⇒ password ⇒ apiID ⇒ requestInfo"
where
"readCApiReq s uID p uID' ≡ cApiReq s uID'"

definition e_readCApiReq :: "state ⇒ userID ⇒ password ⇒ apiID ⇒ bool"
where
"e_readCApiReq s uID p uID' ≡
 IDsOK s [uID] [] [] [] ∧ pass s uID = p ∧
 uID = admin s ∧ uID' ∈∈ pendingCApiReqs s"


subsubsection ‹Listing actions›

(* list pending new user Reqs: *)
definition listPendingUReqs :: "state ⇒ userID ⇒ password ⇒ userID list"
where
"listPendingUReqs s uID p ≡ pendingUReqs s"

definition e_listPendingUReqs :: "state ⇒ userID ⇒ password ⇒ bool"
where
"e_listPendingUReqs s uID p ≡
 IDsOK s [uID] [] [] [] ∧ pass s uID = p ∧ uID = admin s"

(* list all users of the system: *)
definition listAllUsers :: "state ⇒ userID ⇒ password ⇒ userID list"
where
"listAllUsers s uID p ≡ userIDs s"

definition e_listAllUsers :: "state ⇒ userID ⇒ password ⇒ bool"
where
"e_listAllUsers s uID p ≡ IDsOK s [uID] [] [] [] ∧ pass s uID = p"

(* List a user's friends: *)
definition listFriends :: "state ⇒ userID ⇒ password ⇒ userID ⇒ userID list"
where
"listFriends s uID p uID' ≡ friendIDs s uID'"

definition e_listFriends :: "state ⇒ userID ⇒ password ⇒ userID ⇒ bool"
where
"e_listFriends s uID p uID' ≡
 IDsOK s [uID,uID'] [] [] [] ∧ pass s uID = p ∧
 (uID = uID' ∨ uID ∈∈ friendIDs s uID')"

(* List the outer friendship authorizations sent by a user: *)
definition listSentOuterFriends :: "state ⇒ userID ⇒ password ⇒ userID ⇒ (apiID × userID) list"
where
"listSentOuterFriends s uID p uID' ≡ sentOuterFriendIDs s uID'"

definition e_listSentOuterFriends :: "state ⇒ userID ⇒ password ⇒ userID ⇒ bool"
where
"e_listSentOuterFriends s uID p uID' ≡
 IDsOK s [uID,uID'] [] [] [] ∧ pass s uID = p ∧
 (uID = uID' ∨ uID ∈∈ friendIDs s uID')"

(* List the outer friendship authorizations received by a user: *)
definition listRecvOuterFriends :: "state ⇒ userID ⇒ password ⇒ (apiID × userID) list"
where
"listRecvOuterFriends s uID p ≡ recvOuterFriendIDs s uID"

definition e_listRecvOuterFriends :: "state ⇒ userID ⇒ password ⇒ bool"
where
"e_listRecvOuterFriends s uID p ≡
 IDsOK s [uID] [] [] [] ∧ pass s uID = p"

(* list posts internal to the api: *)
definition listInnerPosts :: "state ⇒ userID ⇒ password ⇒ (userID × postID) list"
where
"listInnerPosts s uID p ≡
  [(owner s pID, pID).
    pID ← postIDs s,
    vis s pID ≠ FriendV ∨ uID ∈∈ friendIDs s (owner s pID) ∨ uID = owner s pID
  ]"

definition e_listInnerPosts :: "state ⇒ userID ⇒ password ⇒ bool"
where
"e_listInnerPosts s uID p ≡ IDsOK s [uID] [] [] [] ∧ pass s uID = p"

(* list posts from other apis: *)
definition listOuterPosts :: "state ⇒ userID ⇒ password ⇒ (apiID × postID) list"
where
"listOuterPosts s uID p ≡
  [(saID, pID).
    saID ← serverApiIDs s,
    pID ← outerPostIDs s saID,
    outerVis s saID pID = PublicV ∨ (saID, outerOwner s saID pID) ∈∈ recvOuterFriendIDs s uID
  ]"

definition e_listOuterPosts :: "state ⇒ userID ⇒ password ⇒ bool"
where
"e_listOuterPosts s uID p ≡ IDsOK s [uID] [] [] [] ∧ pass s uID = p"

(* List all the api clients who have already received this post: *)
definition listClientsPost :: "state ⇒ userID ⇒ password ⇒ postID ⇒ (apiID × bool) list"
where
"listClientsPost s uID p pID ≡ sharedWith s pID"

(* Only the admin can see these: *)
definition e_listClientsPost :: "state ⇒ userID ⇒ password ⇒ postID ⇒ bool"
where
"e_listClientsPost s uID p pID ≡
 IDsOK s [uID] [pID] [] [] ∧ pass s uID = p ∧ uID = admin s"


(* list the pending Reqs from the current API to other APIs for them to become servers:  *)
definition listPendingSApiReqs :: "state ⇒ userID ⇒ password ⇒ apiID list"
where
"listPendingSApiReqs s uID p ≡ pendingSApiReqs s"

definition e_listPendingSApiReqs :: "state ⇒ userID ⇒ password ⇒ bool"
where
"e_listPendingSApiReqs s uID p ≡
 IDsOK s [uID] [] [] [] ∧ pass s uID = p ∧ uID = admin s"

(* list the IDs of the server apis: *)
definition listServerAPIs :: "state ⇒ userID ⇒ password ⇒ apiID list"
where
"listServerAPIs s uID p ≡ serverApiIDs s"

definition e_listServerAPIs :: "state ⇒ userID ⇒ password ⇒ bool"
where
"e_listServerAPIs s uID p ≡
 IDsOK s [uID] [] [] [] ∧ pass s uID = p ∧ uID = admin s"


(* list the pending Reqs from APIs that want to become clients of the current API:  *)
definition listPendingCApiReqs :: "state ⇒ userID ⇒ password ⇒ apiID list"
where
"listPendingCApiReqs s uID p ≡ pendingCApiReqs s"

definition e_listPendingCApiReqs :: "state ⇒ userID ⇒ password ⇒ bool"
where
"e_listPendingCApiReqs s uID p ≡
 IDsOK s [uID] [] [] [] ∧ pass s uID = p ∧ uID = admin s"

(* list the IDs of the client apis: *)
definition listClientAPIs :: "state ⇒ userID ⇒ password ⇒ apiID list"
where
"listClientAPIs s uID p ≡ clientApiIDs s"

definition e_listClientAPIs :: "state ⇒ userID ⇒ password ⇒ bool"
where
"e_listClientAPIs s uID p ≡
 IDsOK s [uID] [] [] [] ∧ pass s uID = p ∧ uID = admin s"


subsubsection ‹Actions of communication with other APIs›

(* Note: Some of the communication actions are special in the following sense:
The initiator (the api's admin or, in the case of create outer friend, an arbitrary user, uID)
is different from the observer (another api, aID).  *)

(* The next 4 actions implement the protocol of connecting a server and a client:
-- It starts with the synchronized sendServerReq (with potential client as sender) and
  receiveClientReq (with potential server as receiver)
-- It finishes with the synchronized connectClient (with potential server as sender) and
 connectServer (with potential client as receiver)
 *)


(* Send request to potential server.
 sendServerReq s uID p aID reqInfo does the following: User uID (the admin)
send request to api aID wishing to subscribe to this server;
 In the implementation, the request info along with the URL of the current api (i.e., this api's ID)
 will be sent to the given api aID. *)
definition sendServerReq :: "state ⇒ userID ⇒ password ⇒ apiID ⇒ requestInfo ⇒ (apiID × requestInfo) × state"
where
"sendServerReq s uID p aID reqInfo ≡
 ((aID,reqInfo),
  s ⦇pendingSApiReqs := pendingSApiReqs s @ [aID],
     sApiReq := (sApiReq s) (aID := reqInfo)⦈)"

definition e_sendServerReq :: "state ⇒ userID ⇒ password ⇒ apiID ⇒ requestInfo ⇒ bool"
where
"e_sendServerReq s uID p aID reqInfo ≡
 IDsOK s [uID] [] [] [] ∧ pass s uID = p ∧
 uID = admin s ∧ ¬ aID ∈∈ pendingSApiReqs s"

(* Receive request from potential client.
receiveClientReq s aID reqInfo does the following: receives registration request from
potential client api aID (which is a URL) with request info reqInfo. This action is
not trigered from any user of the current API -- it is an even coming from outside.
*)

definition receiveClientReq :: "state ⇒ apiID ⇒ requestInfo ⇒ state"
where
"receiveClientReq s aID reqInfo ≡
 s ⦇pendingCApiReqs := pendingCApiReqs s @ [aID],
    cApiReq := (cApiReq s) (aID := reqInfo)⦈"

definition e_receiveClientReq :: "state ⇒ apiID ⇒ requestInfo ⇒ bool"
where
"e_receiveClientReq s aID reqInfo ≡
 ¬ aID ∈∈ pendingCApiReqs s ∧ admin s ∈∈ userIDs s"

(* Connect a client that had made a registration request.
connectClient s uID p aID cp does the following: The user uID (the admin)
picks up an api id aID from the list of pending requests and registers it as a client.
At the same time, it issues a password cp for the client, stores it and sends it to aID.
*)

definition connectClient :: "state ⇒ userID ⇒ password ⇒ apiID ⇒ password ⇒ (apiID × password) × state"
where
"connectClient s uID p aID cp ≡
 ((aID, cp),
  s ⦇clientApiIDs := (aID # clientApiIDs s),
     clientPass := (clientPass s) (aID := cp),
     pendingCApiReqs := remove1 aID (pendingCApiReqs s),
     cApiReq := (cApiReq s)(aID := emptyRequestInfo)⦈
 )"

definition e_connectClient :: "state ⇒ userID ⇒ password ⇒ apiID ⇒ password ⇒ bool"
where
"e_connectClient s uID p aID cp ≡
 IDsOK s [uID] [] [] [] ∧ pass s uID = p ∧
 uID = admin s ∧
 aID ∈∈ pendingCApiReqs s ∧ ¬ aID ∈∈ clientApiIDs s"

(* Connect server api
connectServer s aID sp does the following: receives the password sp issued
by the potential server aID and stores it. It will be used for communicating with that server.
Of course, this action only succeeds if a request to aID had really been posted (which was
recorded in pendingSApiReqs).
*)
definition connectServer :: "state ⇒ apiID ⇒ password ⇒ state"
where
"connectServer s aID sp ≡
 s ⦇serverApiIDs := (aID # serverApiIDs s),
    serverPass := (serverPass s) (aID := sp),
    pendingSApiReqs := remove1 aID (pendingSApiReqs s),
    sApiReq := (sApiReq s)(aID := emptyRequestInfo)⦈"

definition e_connectServer :: "state ⇒ apiID ⇒ password ⇒ bool"
where
"e_connectServer s aID sp ≡
 aID ∈∈ pendingSApiReqs s ∧ ¬ aID ∈∈ serverApiIDs s"

(* The next 2 actions represent server-client communication (always from server to client):
-- The server sends a post via sendPost
-- The client receives it via receivePost
Note that, since only the server sends messages to the client, it is the server who authenticates itself.
 *)

(* Send a post and its owner's ID (as well as the server credentials for communicating with that
client) to a client api. Also, recall that the post has now been shared with that client.  *)
definition sendPost ::
"state ⇒ userID ⇒ password ⇒ apiID ⇒ postID ⇒ (apiID × password × postID × post × userID × vis) × state"
where
"sendPost s uID p aID pID ≡
 ((aID, clientPass s aID, pID, post s pID, owner s pID, vis s pID),
  s⦇sharedWith := (sharedWith s) (pID := insert2 aID True (sharedWith s pID))⦈)"

definition e_sendPost :: "state ⇒ userID ⇒ password ⇒ apiID ⇒ postID ⇒ bool"
where
"e_sendPost s uID p aID pID ≡
 IDsOK s [uID] [pID] [] [aID] ∧ pass s uID = p ∧
 uID = admin s ∧ aID ∈∈ clientApiIDs s"

(* Receive a post and its owner's ID (as well as the server credentials) from a server api. *)
definition receivePost :: "state ⇒ apiID ⇒ password ⇒ postID ⇒ post ⇒ userID ⇒ vis ⇒ state"
where
"receivePost s aID sp pID pst uID vs ≡
 let opIDs = outerPostIDs s in
 s ⦇outerPostIDs := opIDs (aID :=  List.insert pID (opIDs aID)),
    outerPost := fun_upd2 (outerPost s) aID pID pst,
    outerOwner := fun_upd2 (outerOwner s) aID pID uID,
    outerVis := fun_upd2 (outerVis s) aID pID vs⦈"

definition e_receivePost :: "state ⇒ apiID ⇒ password ⇒ postID ⇒ post ⇒ userID ⇒ vis ⇒ bool"
where
"e_receivePost s aID sp pID nt uID vs ≡
 IDsOK s [] [] [(aID,[])] [] ∧ serverPass s aID = sp"


(* Create outer friend; unlike inner friendship, outer friendship is not necessarily symmetric.
It is always established from a user of a server to a user of a client, the former giving
unilateral access to the latter at his friend-only posts. These unilateral friendship permissions
are stored on the client.*)

(* sendCreateOFriend s uID p aID uID' means: User uID (of current api), with password p,
  sends an I-set-you-as-my-friend note to the presumptive user uID' on client api aID.
  The request uses the server credentials for the given client, as customary. *)
definition sendCreateOFriend ::
  "state ⇒ userID ⇒ password ⇒ apiID ⇒ userID ⇒ (apiID × password × userID × userID) × state"
where
"sendCreateOFriend s uID p aID uID' ≡
 let ofr = sentOuterFriendIDs s in
 ((aID, clientPass s aID, uID, uID'),
  s ⦇sentOuterFriendIDs := ofr (uID := ofr uID @ [(aID,uID')])⦈)"

(* Note that the server (who issues the note) cannot check if uID' is a valid user on the client.
This will be checked on the client api only.*)
definition e_sendCreateOFriend :: "state ⇒ userID ⇒ password ⇒ apiID ⇒ userID ⇒ bool"
where
"e_sendCreateOFriend s uID p caID uID' ≡
 IDsOK s [uID] [] [] [caID] ∧ pass s uID = p ∧
 ¬ (caID,uID') ∈∈ sentOuterFriendIDs s uID"

(* receiveCreateOFriend s sp saID uID uID' means: The current api receives, from
 one of its registered server apis aAID with password sp, an I-set-you-as-my-friend
 note from aAID's presumptive user uID to the current api's user uID'. The effect
 is that the current api will mark (saID,uID) in the list of outer friends of uID'
 (hence will allow uID' access to friend-only outer posts from uID). *)

definition receiveCreateOFriend :: "state ⇒ apiID ⇒ password ⇒ userID ⇒ userID ⇒ state"
where
"receiveCreateOFriend s saID sp uID uID' ≡
 let ofr = recvOuterFriendIDs s in
 s ⦇recvOuterFriendIDs := ofr (uID' := ofr uID' @ [(saID,uID)])⦈"

definition e_receiveCreateOFriend :: "state ⇒ apiID ⇒ password ⇒ userID ⇒ userID ⇒ bool"
where
"e_receiveCreateOFriend s saID sp uID uID' ≡
 IDsOK s [] [] [(saID,[])] [] ∧ serverPass s saID = sp ∧
 ¬ (saID,uID) ∈∈ recvOuterFriendIDs s uID'"


(* Deletion of outer friends *)

definition sendDeleteOFriend ::
  "state ⇒ userID ⇒ password ⇒ apiID ⇒ userID ⇒ (apiID × password × userID × userID) × state"
where
"sendDeleteOFriend s uID p aID uID' ≡
 let ofr = sentOuterFriendIDs s in
 ((aID, clientPass s aID, uID, uID'),
  s ⦇sentOuterFriendIDs := ofr (uID := remove1 (aID,uID') (ofr uID))⦈)"

definition e_sendDeleteOFriend :: "state ⇒ userID ⇒ password ⇒ apiID ⇒ userID ⇒ bool"
where
"e_sendDeleteOFriend s uID p caID uID' ≡
 IDsOK s [uID] [] [] [caID] ∧ pass s uID = p ∧
 (caID,uID') ∈∈ sentOuterFriendIDs s uID"

definition receiveDeleteOFriend :: "state ⇒ apiID ⇒ password ⇒ userID ⇒ userID ⇒ state"
where
"receiveDeleteOFriend s saID sp uID uID' ≡
 let ofr = recvOuterFriendIDs s in
 s ⦇recvOuterFriendIDs := ofr (uID' := remove1 (saID,uID) (ofr uID'))⦈"

definition e_receiveDeleteOFriend :: "state ⇒ apiID ⇒ password ⇒ userID ⇒ userID ⇒ bool"
where
"e_receiveDeleteOFriend s saID sp uID uID' ≡
 IDsOK s [] [] [(saID,[])] [] ∧ serverPass s saID = sp ∧
 (saID,uID) ∈∈ recvOuterFriendIDs s uID'"




subsection ‹The step function›

datatype out =
  (* Outputs for creation and update actions, as well as for other actions with errors: *)
  outOK | outErr |
  (* Outputs for reading actions: *)
  outBool bool| outName name |
  outPost post | outVis vis |
  outReq requestInfo |
  (* Outputs for listing actions: *)
  outUID "userID" | outUIDL "userID list" |
  outAIDL "apiID list"  |  outAIDBL "(apiID × bool) list"  |
  outUIDPIDL "(userID × postID)list" | outAIDPIDL "(apiID × postID)list" |
  outAIDUIDL "(apiID × userID) list" |
  (* Outputs specific to communication actions: *)
  O_sendServerReq "apiID × requestInfo" | O_connectClient "apiID × password" |
  O_sendPost "apiID × password × postID × post × userID × vis" |
  O_sendCreateOFriend "apiID × password × userID × userID" |
  O_sendDeleteOFriend "apiID × password × userID × userID"


(* The content from outAIDPIDTT outputs: *)
fun from_O_sendPost where
 "from_O_sendPost (O_sendPost antt) = antt"
|"from_O_sendPost _ = undefined"


(* Start actions (only one, but wrapped for uniformity): *)
datatype sActt =
  sSys userID password

lemmas s_defs =
e_startSys_def startSys_def

fun sStep :: "state ⇒ sActt ⇒ out * state" where
"sStep s (sSys uID p) =
 (if e_startSys s uID p
    then (outOK, startSys s uID p)
    else (outErr, s))"

fun sUserOfA :: "sActt ⇒ userID" where
 "sUserOfA (sSys uID p) = uID"

(* Creation actions: *)
datatype cActt =
  cNUReq userID requestInfo
 |cUser userID password userID password
 |cPost userID password postID
 |cFriendReq userID password userID requestInfo
 |cFriend userID password userID

lemmas c_defs =
e_createNUReq_def createNUReq_def
e_createUser_def createUser_def
e_createPost_def createPost_def
e_createFriendReq_def createFriendReq_def
e_createFriend_def createFriend_def

fun cStep :: "state ⇒ cActt ⇒ out * state" where
"cStep s (cNUReq uID req) =
 (if e_createNUReq s uID req
    then (outOK, createNUReq s uID req)
    else (outErr, s))"
|
"cStep s (cUser uID p uID' p') =
 (if e_createUser s uID p uID' p'
    then (outOK, createUser s uID p uID' p')
    else (outErr, s))"
|
"cStep s (cPost uID p pID) =
 (if e_createPost s uID p pID
    then (outOK, createPost s uID p pID)
    else (outErr, s))"
|
"cStep s (cFriendReq uID p uID' req) =
 (if e_createFriendReq s uID p uID' req
    then (outOK, createFriendReq s uID p uID' req)
    else (outErr, s))"
|
"cStep s (cFriend uID p uID') =
 (if e_createFriend s uID p uID'
    then (outOK, createFriend s uID p uID')
    else (outErr, s))"

fun cUserOfA :: "cActt ⇒ userID" where
 "cUserOfA (cNUReq uID req) = uID"
|"cUserOfA (cUser uID p uID' p') = uID"
|"cUserOfA (cPost uID p pID) = uID"
|"cUserOfA (cFriendReq uID p uID' req) = uID"
|"cUserOfA (cFriend uID p uID') = uID"

(* Deletion (removal) actions -- currently only friends can be deleted *)

datatype dActt =
  dFriend userID password userID

lemmas d_defs =
e_deleteFriend_def deleteFriend_def

fun dStep :: "state ⇒ dActt ⇒ out * state" where
"dStep s (dFriend uID p uID') =
 (if e_deleteFriend s uID p uID'
    then (outOK, deleteFriend s uID p uID')
    else (outErr, s))"

fun dUserOfA :: "dActt ⇒ userID" where
 "dUserOfA (dFriend uID p uID') = uID"

(* Update actions: *)
datatype uActt =
  isuUser: uUser userID password password name inform
 |isuPost: uPost userID password postID post
 |isuVisPost: uVisPost userID password postID vis

lemmas u_defs =
e_updateUser_def updateUser_def
e_updatePost_def updatePost_def
e_updateVisPost_def updateVisPost_def

fun uStep :: "state ⇒ uActt ⇒ out * state" where
"uStep s (uUser uID p p' name info) =
 (if e_updateUser s uID p p' name info
    then (outOK, updateUser s uID p p' name info)
    else (outErr, s))"
|
"uStep s (uPost uID p pID pst) =
 (if e_updatePost s uID p pID pst
    then (outOK, updatePost s uID p pID pst)
    else (outErr, s))"
|
"uStep s (uVisPost uID p pID visStr) =
 (if e_updateVisPost s uID p pID visStr
    then (outOK, updateVisPost s uID p pID visStr)
    else (outErr, s))"

fun uUserOfA :: "uActt ⇒ userID" where
 "uUserOfA (uUser uID p p' name info) = uID"
|"uUserOfA (uPost uID p pID pst) = uID"
|"uUserOfA (uVisPost uID p pID visStr) = uID"


(* Read actions: *)
datatype rActt =
  rNUReq userID password userID
 |rUser userID password userID
 |rAmIAdmin userID password

 |rPost userID password postID

 |rOwnerPost userID password postID
 |rVisPost userID password postID

 |rOPost userID password apiID postID

 |rOwnerOPost userID password apiID postID
 |rVisOPost userID password apiID postID

 |rFriendReqToMe userID password userID
 |rFriendReqFromMe userID password userID
 |rSApiReq userID password apiID
 |rCApiReq userID password apiID

lemmas r_defs =
 readNUReq_def e_readNUReq_def
 readUser_def e_readUser_def
 readAmIAdmin_def e_readAmIAdmin_def

 readPost_def e_readPost_def

 readOwnerPost_def e_readOwnerPost_def
 readVisPost_def e_readVisPost_def

 readOPost_def e_readOPost_def

 readOwnerOPost_def e_readOwnerOPost_def
 readVisOPost_def e_readVisOPost_def

 readFriendReqToMe_def e_readFriendReqToMe_def
 readFriendReqFromMe_def e_readFriendReqFromMe_def
 readSApiReq_def e_readSApiReq_def
 readCApiReq_def e_readCApiReq_def

fun rObs :: "state ⇒ rActt ⇒ out" where
"rObs s (rNUReq uID p uID') =
 (if e_readNUReq s uID p uID' then outReq (readNUReq s uID p uID') else outErr)"
|
"rObs s (rUser uID p uID') =
 (if e_readUser s uID p uID' then outName (readUser s uID p uID') else outErr)"
|
"rObs s (rAmIAdmin uID p) =
 (if e_readAmIAdmin s uID p then outBool (readAmIAdmin s uID p) else outErr)"
|
"rObs s (rPost uID p pID) =
 (if e_readPost s uID p pID then outPost (readPost s uID p pID) else outErr)"
|
"rObs s (rOwnerPost uID p pID) =
 (if e_readOwnerPost s uID p pID then outUID (readOwnerPost s uID p pID) else outErr)"
|
"rObs s (rVisPost uID p pID) =
 (if e_readVisPost s uID p pID then outVis (readVisPost s uID p pID) else outErr)"
|
"rObs s (rOPost uID p aID pID) =
 (if e_readOPost s uID p aID pID then outPost (readOPost s uID p aID pID) else outErr)"
|
"rObs s (rOwnerOPost uID p aID pID) =
 (if e_readOwnerOPost s uID p aID pID then outUID (readOwnerOPost s uID p aID pID) else outErr)"
|
"rObs s (rVisOPost uID p aID pID) =
 (if e_readVisOPost s uID p aID pID then outVis (readVisOPost s uID p aID pID) else outErr)"
|

"rObs s (rFriendReqToMe uID p uID') =
 (if e_readFriendReqToMe s uID p uID' then outReq (readFriendReqToMe s uID p uID') else outErr)"
|
"rObs s (rFriendReqFromMe uID p uID') =
 (if e_readFriendReqFromMe s uID p uID' then outReq (readFriendReqFromMe s uID p uID') else outErr)"
|
"rObs s (rSApiReq uID p aID) =
 (if e_readSApiReq s uID p aID then outReq (readSApiReq s uID p aID) else outErr)"
|
"rObs s (rCApiReq uID p aID) =
 (if e_readCApiReq s uID p aID then outReq (readCApiReq s uID p aID) else outErr)"


fun rUserOfA :: "rActt ⇒ userID" where
 "rUserOfA (rNUReq uID p uID') = uID"
|"rUserOfA (rUser uID p uID') = uID"
|"rUserOfA (rAmIAdmin uID p) = uID"

|"rUserOfA (rPost uID p pID) = uID"
|"rUserOfA (rOwnerPost uID p pID) = uID"
|"rUserOfA (rVisPost uID p pID) = uID"

|"rUserOfA (rOPost uID p aID pID) = uID"
|"rUserOfA (rOwnerOPost uID p aID pID) = uID"
|"rUserOfA (rVisOPost uID p aID pID) = uID"

|"rUserOfA (rFriendReqToMe uID p uID') = uID"
|"rUserOfA (rFriendReqFromMe uID p uID') = uID"
|"rUserOfA (rSApiReq uID p aID) = uID"
|"rUserOfA (rCApiReq uID p aID) = uID"


(* Listing actions *)
datatype lActt =
  lPendingUReqs userID password
 |lAllUsers userID password
 |lFriends userID password userID
 |lSentOuterFriends userID password userID
 |lRecvOuterFriends userID password
 |lInnerPosts userID password
 |lOuterPosts userID password
 |lClientsPost userID password postID
 |lPendingSApiReqs userID password
 |lServerAPIs userID password
 |lPendingCApiReqs userID password
 |lClientAPIs userID password

lemmas l_defs =
 listPendingUReqs_def e_listPendingUReqs_def
 listAllUsers_def e_listAllUsers_def
 listFriends_def e_listFriends_def
 listSentOuterFriends_def e_listSentOuterFriends_def
 listRecvOuterFriends_def e_listRecvOuterFriends_def
 listInnerPosts_def e_listInnerPosts_def
 listOuterPosts_def e_listOuterPosts_def
 listClientsPost_def e_listClientsPost_def
 listPendingSApiReqs_def e_listPendingSApiReqs_def
 listServerAPIs_def e_listServerAPIs_def
 listPendingCApiReqs_def e_listPendingCApiReqs_def
 listClientAPIs_def e_listClientAPIs_def


fun lObs :: "state ⇒ lActt ⇒ out" where
"lObs s (lPendingUReqs uID p) =
 (if e_listPendingUReqs s uID p then outUIDL (listPendingUReqs s uID p) else outErr)"
|
"lObs s (lAllUsers uID p) =
 (if e_listAllUsers s uID p then outUIDL (listAllUsers s uID p) else outErr)"
|
"lObs s (lFriends uID p uID') =
 (if e_listFriends s uID p uID' then outUIDL (listFriends s uID p uID') else outErr)"
|
"lObs s (lSentOuterFriends uID p uID') =
 (if e_listSentOuterFriends s uID p uID' then outAIDUIDL (listSentOuterFriends s uID p uID') else outErr)"
|
"lObs s (lRecvOuterFriends uID p) =
 (if e_listRecvOuterFriends s uID p then outAIDUIDL (listRecvOuterFriends s uID p) else outErr)"
|
"lObs s (lInnerPosts uID p) =
 (if e_listInnerPosts s uID p then outUIDPIDL (listInnerPosts s uID p) else outErr)"
|
"lObs s (lOuterPosts uID p) =
 (if e_listOuterPosts s uID p then outAIDPIDL (listOuterPosts s uID p) else outErr)"
|
"lObs s (lClientsPost uID p pID) =
 (if e_listClientsPost s uID p pID then outAIDBL (listClientsPost s uID p pID) else outErr)"
|
"lObs s (lPendingSApiReqs uID p) =
 (if e_listPendingSApiReqs s uID p then outAIDL (listPendingSApiReqs s uID p) else outErr)"
|
"lObs s (lServerAPIs uID p) =
 (if e_listServerAPIs s uID p then outAIDL (listServerAPIs s uID p) else outErr)"
|
"lObs s (lClientAPIs uID p) =
 (if e_listClientAPIs s uID p then outAIDL (listClientAPIs s uID p) else outErr)"
|
"lObs s (lPendingCApiReqs uID p) =
 (if e_listPendingCApiReqs s uID p then outAIDL (listPendingCApiReqs s uID p) else outErr)"

fun lUserOfA :: "lActt ⇒ userID" where
 "lUserOfA (lPendingUReqs uID p) = uID"
|"lUserOfA (lAllUsers uID p) = uID"
|"lUserOfA (lFriends uID p uID') = uID"
|"lUserOfA (lSentOuterFriends uID p uID') = uID"
|"lUserOfA (lRecvOuterFriends uID p) = uID"
|"lUserOfA (lInnerPosts uID p) = uID"
|"lUserOfA (lOuterPosts uID p) = uID"
|"lUserOfA (lClientsPost uID p pID) = uID"
|"lUserOfA (lPendingSApiReqs uID p) = uID"
|"lUserOfA (lServerAPIs uID p) = uID"
|"lUserOfA (lClientAPIs uID p) = uID"
|"lUserOfA (lPendingCApiReqs uID p) = uID"


(* Communication actions *)

datatype comActt =
  comSendServerReq userID password apiID requestInfo
 |comReceiveClientReq apiID requestInfo
 |comConnectClient userID password apiID password
 |comConnectServer apiID password
 |comReceivePost apiID password postID post userID vis
 |comSendPost userID password apiID postID
 |comReceiveCreateOFriend apiID password userID userID
 |comSendCreateOFriend userID password apiID userID
 |comReceiveDeleteOFriend apiID password userID userID
 |comSendDeleteOFriend userID password apiID userID

lemmas com_defs =
 sendServerReq_def e_sendServerReq_def
 receiveClientReq_def e_receiveClientReq_def
 connectClient_def e_connectClient_def
 connectServer_def e_connectServer_def
 receivePost_def e_receivePost_def
 sendPost_def e_sendPost_def
 receiveCreateOFriend_def e_receiveCreateOFriend_def
 sendCreateOFriend_def e_sendCreateOFriend_def
 receiveDeleteOFriend_def e_receiveDeleteOFriend_def
 sendDeleteOFriend_def e_sendDeleteOFriend_def

fun comStep :: "state ⇒ comActt ⇒ out × state" where
"comStep s (comSendServerReq uID p aID reqInfo) =
 (if e_sendServerReq s uID p aID reqInfo
    then let (x,s) = sendServerReq s uID p aID reqInfo in (O_sendServerReq x, s)
    else (outErr, s))"
|
"comStep s (comReceiveClientReq aID reqInfo) =
 (if e_receiveClientReq s aID reqInfo then (outOK, receiveClientReq s aID reqInfo) else (outErr, s))"
|
"comStep s (comConnectClient uID p aID cp) =
 (if e_connectClient s uID p aID cp
    then let (aID_cp,s) = connectClient s uID p aID cp in (O_connectClient aID_cp, s)
    else (outErr, s))"
|
"comStep s (comConnectServer aID sp) =
 (if e_connectServer s aID sp then (outOK, connectServer s aID sp) else (outErr, s))"
|
"comStep s (comReceivePost aID sp pID nt uID vs) =
 (if e_receivePost s aID sp pID nt uID vs
    then (outOK, receivePost s aID sp pID nt uID vs)
    else (outErr, s))"
|
"comStep s (comSendPost uID p aID pID) =
 (if e_sendPost s uID p aID pID
    then let (x,s) = sendPost s uID p aID pID in (O_sendPost x, s)
    else (outErr, s))"
|
"comStep s (comReceiveCreateOFriend aID cp uID uID') =
 (if e_receiveCreateOFriend s aID cp uID uID'
    then (outOK, receiveCreateOFriend s aID cp uID uID')
    else (outErr, s))"
|
"comStep s (comSendCreateOFriend uID p aID uID') =
 (if e_sendCreateOFriend s uID p aID uID'
    then let (apuu,s) = sendCreateOFriend s uID p aID uID' in (O_sendCreateOFriend apuu, s)
    else (outErr, s))"
|
"comStep s (comReceiveDeleteOFriend aID cp uID uID') =
 (if e_receiveDeleteOFriend s aID cp uID uID'
    then (outOK, receiveDeleteOFriend s aID cp uID uID')
    else (outErr, s))"
|
"comStep s (comSendDeleteOFriend uID p aID uID') =
 (if e_sendDeleteOFriend s uID p aID uID'
    then let (apuu,s) = sendDeleteOFriend s uID p aID uID' in (O_sendDeleteOFriend apuu, s)
    else (outErr, s))"


fun comUserOfA :: "comActt ⇒ userID option" where
 "comUserOfA (comSendServerReq uID p aID reqInfo) = Some uID"
|"comUserOfA (comReceiveClientReq aID reqInfo) = None"
|"comUserOfA (comConnectClient uID p aID sp) = Some uID"
|"comUserOfA (comConnectServer aID sp) = None"
|"comUserOfA (comReceivePost aID sp pID nt uID vs) = None"
|"comUserOfA (comSendPost uID p aID pID) = Some uID"
|"comUserOfA (comReceiveCreateOFriend aID cp uID uID') = None"
|"comUserOfA (comSendCreateOFriend uID p aID uID') = Some uID"
|"comUserOfA (comReceiveDeleteOFriend aID cp uID uID') = None"
|"comUserOfA (comSendDeleteOFriend uID p aID uID') = Some uID"

fun comApiOfA :: "comActt ⇒ apiID" where
 "comApiOfA (comSendServerReq uID p aID reqInfo) = aID"
|"comApiOfA (comReceiveClientReq aID reqInfo) = aID"
|"comApiOfA (comConnectClient uID p aID sp) = aID"
|"comApiOfA (comConnectServer aID sp) = aID"
|"comApiOfA (comReceivePost aID sp pID nt uID vs) = aID"
|"comApiOfA (comSendPost uID p aID pID) = aID"
|"comApiOfA (comReceiveCreateOFriend aID cp uID uID') = aID"
|"comApiOfA (comSendCreateOFriend uID p aID uID') = aID"
|"comApiOfA (comReceiveDeleteOFriend aID cp uID uID') = aID"
|"comApiOfA (comSendDeleteOFriend uID p aID uID') = aID"


(* All actions: *)
datatype act =
  isSact: Sact sActt |
(* 3 kinds of effects: creation, deletion and update *)
  isCact: Cact cActt | isDact: Dact dActt | isUact: Uact uActt |
(* 2 kinds of observations: reading and listing (the latter mainly printing IDs) *)
  isRact: Ract rActt | isLact: Lact lActt |
(* Communications, which can themselves be either effects or ovbservations: *)
  isCOMact: COMact comActt

fun step :: "state ⇒ act ⇒ out * state" where
"step s (Sact sa) = sStep s sa"
|
"step s (Cact ca) = cStep s ca"
|
"step s (Dact da) = dStep s da"
|
"step s (Uact ua) = uStep s ua"
|
"step s (Ract ra) = (rObs s ra, s)"
|
"step s (Lact la) = (lObs s la, s)"
|
"step s (COMact ca) = comStep s ca"

fun userOfA :: "act ⇒ userID option" where
"userOfA (Sact sa) = Some (sUserOfA sa)"
|
"userOfA (Cact ca) = Some (cUserOfA ca)"
|
"userOfA (Dact da) = Some (dUserOfA da)"
|
"userOfA (Uact ua) = Some (uUserOfA ua)"
|
"userOfA (Ract ra) = Some (rUserOfA ra)"
|
"userOfA (Lact la) = Some (lUserOfA la)"
|
"userOfA (COMact ca) = comUserOfA ca"


interpretation IO_Automaton where
istate = istate and step = step
done


subsection ‹Code generation›

export_code step istate getFreshPostID in Scala

end
y>

Theory API_Network

section ‹The CoSMeDis network of communicating nodes ›

text ‹This is the specification of an entire CoSMeDis network
of communicating  nodes, as described
in Section IV.B of \cite{cosmedis-SandP2017}
NB: What that paper refers to as "nodes" are referred in this formalization
as "APIs".
›

theory API_Network
imports
  "BD_Security_Compositional.Composing_Security_Network"
  System_Specification
begin

locale Network =
fixes AIDs :: "apiID set"
assumes finite_AIDs: "finite AIDs"
begin

fun comOfO :: "apiID ⇒ (act × out) ⇒ com" where
  "comOfO aid (COMact (comSendServerReq uid password aID req), ou) =
    (if aid ≠ aID ∧ ou ≠ outErr then Send else Internal)"
| "comOfO aid (COMact (comConnectClient uID p aID sp), ou) =
    (if aid ≠ aID ∧ ou ≠ outErr then Send else Internal)"
| "comOfO aid (COMact (comSendPost uID p aID nID), ou) =
    (if aid ≠ aID ∧ ou ≠ outErr then Send else Internal)"
| "comOfO aid (COMact (comSendCreateOFriend uID p aID uID'), ou) =
    (if aid ≠ aID ∧ ou ≠ outErr then Send else Internal)"
| "comOfO aid (COMact (comSendDeleteOFriend uID p aID uID'), ou) =
    (if aid ≠ aID ∧ ou ≠ outErr then Send else Internal)"
| "comOfO aid (COMact (comReceiveClientReq aID req), ou) =
    (if aid ≠ aID ∧ ou ≠ outErr then Recv else Internal)"
| "comOfO aid (COMact (comConnectServer aID sp), ou) =
    (if aid ≠ aID ∧ ou ≠ outErr then Recv else Internal)"
| "comOfO aid (COMact (comReceivePost aID sp nID ntc uid v), ou) =
    (if aid ≠ aID ∧ ou ≠ outErr then Recv else Internal)"
| "comOfO aid (COMact (comReceiveCreateOFriend aID sp uid uid'), ou) =
    (if aid ≠ aID ∧ ou ≠ outErr then Recv else Internal)"
| "comOfO aid (COMact (comReceiveDeleteOFriend aID sp uid uid'), ou) =
    (if aid ≠ aID ∧ ou ≠ outErr then Recv else Internal)"
| "comOfO _ _ = Internal"

fun comOf :: "apiID ⇒ (state, act, out) trans ⇒ com" where
  "comOf aid (Trans _ a ou _) = comOfO aid (a, ou)"

fun syncO :: "apiID ⇒ (act × out) ⇒ apiID ⇒ (act × out) ⇒ bool" where
  "syncO aid1 (COMact (comSendServerReq uid p aid req), ou1) aid2 (a2, ou2) =
     (∃req2. a2 = (COMact (comReceiveClientReq aid1 req2)) ∧ ou1 = O_sendServerReq (aid2,req2) ∧ ou2 = outOK)"
| "syncO aid1 (COMact (comConnectClient uid p aid sp), ou1) aid2 (a2, ou2) =
     (∃sp2. a2 = (COMact (comConnectServer aid1 sp2)) ∧ ou1 = O_connectClient (aid2,sp2) ∧ ou2 = outOK)"
| "syncO aid1 (COMact (comSendPost uid p aid nid), ou1) aid2 (a2, ou2) =
     (∃sp2 nid2 ntc2 uid2 v. a2 = (COMact (comReceivePost aid1 sp2 nid2 ntc2 uid2 v)) ∧ ou1 = O_sendPost (aid2, sp2, nid2, ntc2, uid2, v) ∧ ou2 = outOK)"
| "syncO aid1 (COMact (comSendCreateOFriend uid p aid uid'), ou1) aid2 (a2, ou2) =
     (∃sp2 uid2 uid2'. a2 = (COMact (comReceiveCreateOFriend aid1 sp2 uid2 uid2')) ∧ ou1 = O_sendCreateOFriend (aid2, sp2, uid2, uid2') ∧ ou2 = outOK)"
| "syncO aid1 (COMact (comSendDeleteOFriend uid p aid uid'), ou1) aid2 (a2, ou2) =
     (∃sp2 uid2 uid2'. a2 = (COMact (comReceiveDeleteOFriend aid1 sp2 uid2 uid2')) ∧ ou1 = O_sendDeleteOFriend (aid2, sp2, uid2, uid2') ∧ ou2 = outOK)"
| "syncO _ _ _ _ = False"

fun cmpO :: "apiID ⇒ (act × out) ⇒ apiID ⇒ (act × out) ⇒ (apiID × act × out × apiID × act × out)" where
  "cmpO aid1 obs1 aid2 obs2 = (aid1, fst obs1, snd obs1, aid2, fst obs2, snd obs2)"

fun sync :: "apiID ⇒ (state, act, out) trans ⇒ apiID ⇒ (state, act, out) trans ⇒ bool" where
  "sync aid1 (Trans s1 a1 ou1 s1') aid2 (Trans s2 a2 ou2 s2') = syncO aid1 (a1, ou1) aid2 (a2, ou2)"


lemma syncO_cases:
assumes "syncO aid1 obs1 aid2 obs2"
obtains
  (Req) uid p aid req1 req2
  where "obs1 = (COMact (comSendServerReq uid p aid req1), O_sendServerReq (aid2,req2))"
    and "obs2 = (COMact (comReceiveClientReq aid1 req2), outOK)"
| (Connect) uid p aid sp sp2
  where "obs1 = (COMact (comConnectClient uid p aid sp), O_connectClient (aid2,sp2))"
    and "obs2 = (COMact (comConnectServer aid1 sp2), outOK)"
| (Notice) uid p aid nid sp2 nid2 ntc2 own2 v
  where "obs1 = (COMact (comSendPost uid p aid nid), O_sendPost (aid2, sp2, nid2, ntc2, own2, v))"
    and "obs2 = (COMact (comReceivePost aid1 sp2 nid2 ntc2 own2 v), outOK)"
| (CFriend) uid p aid uid' sp2 uid2 uid2'
  where "obs1 = (COMact (comSendCreateOFriend uid p aid uid'), O_sendCreateOFriend (aid2, sp2, uid2, uid2'))"
    and "obs2 = (COMact (comReceiveCreateOFriend aid1 sp2 uid2 uid2'), outOK)"
| (DFriend) uid p aid uid' sp2 uid2 uid2'
  where "obs1 = (COMact (comSendDeleteOFriend uid p aid uid'), O_sendDeleteOFriend (aid2, sp2, uid2, uid2'))"
    and "obs2 = (COMact (comReceiveDeleteOFriend aid1 sp2 uid2 uid2'), outOK)"
using assms by (cases "(aid1,obs1,aid2,obs2)" rule: syncO.cases) auto

lemma sync_cases:
assumes "sync aid1 trn1 aid2 trn2"
and "validTrans trn1"
obtains
  (Req) uid p aid req s1 s1' s2 s2'
  where "trn1 = Trans s1 (COMact (comSendServerReq uid p aid req)) (O_sendServerReq (aid2,req)) s1'"
    and "trn2 = Trans s2 (COMact (comReceiveClientReq aid1 req)) outOK s2'"
| (Connect) uid p aid sp s1 s1' s2 s2'
  where "trn1 = Trans s1 (COMact (comConnectClient uid p aid sp)) (O_connectClient (aid2,sp)) s1'"
    and "trn2 = Trans s2 (COMact (comConnectServer aid1 sp)) outOK s2'"
| (Notice) uid p aid nid sp2 nid2 ntc2 own2 v s1 s1' s2 s2'
  where "trn1 = Trans s1 (COMact (comSendPost uid p aid nid)) (O_sendPost (aid2, sp2, nid2, ntc2, own2, v)) s1'"
    and "trn2 = Trans s2 (COMact (comReceivePost aid1 sp2 nid2 ntc2 own2 v)) outOK s2'"
| (CFriend) uid p uid' sp s1 s1' s2 s2'
  where "trn1 = Trans s1 (COMact (comSendCreateOFriend uid p aid2 uid')) (O_sendCreateOFriend (aid2, sp, uid, uid')) s1'"
    and "trn2 = Trans s2 (COMact (comReceiveCreateOFriend aid1 sp uid uid')) outOK s2'"
| (DFriend) uid p aid uid' sp s1 s1' s2 s2'
  where "trn1 = Trans s1 (COMact (comSendDeleteOFriend uid p aid2 uid')) (O_sendDeleteOFriend (aid2, sp, uid, uid')) s1'"
    and "trn2 = Trans s2 (COMact (comReceiveDeleteOFriend aid1 sp uid uid')) outOK s2'"
  using assms
  by (cases trn1; cases trn2) (auto elim!: syncO_cases simp: com_defs split: if_splits)

fun tgtNodeOfO :: "apiID ⇒ (act × out) ⇒ apiID" where
  "tgtNodeOfO _ (COMact (comSendServerReq uID p aID reqInfo), ou) = aID"
| "tgtNodeOfO _ (COMact (comReceiveClientReq aID reqInfo), ou) = aID"
| "tgtNodeOfO _ (COMact (comConnectClient uID p aID sp), ou) = aID"
| "tgtNodeOfO _ (COMact (comConnectServer aID sp), ou) = aID"
| "tgtNodeOfO _ (COMact (comSendPost uID p aID nID), ou) = aID"
| "tgtNodeOfO _ (COMact (comReceivePost aID sp nID title text v), ou) = aID"
| "tgtNodeOfO _ (COMact (comSendCreateOFriend uID p aID uID'), ou) = aID"
| "tgtNodeOfO _ (COMact (comReceiveCreateOFriend aID sp uid uid'), ou) = aID"
| "tgtNodeOfO _ (COMact (comSendDeleteOFriend uID p aID uID'), ou) = aID"
| "tgtNodeOfO _ (COMact (comReceiveDeleteOFriend aID sp uid uid'), ou) = aID"
| "tgtNodeOfO _ _ = undefined"

fun tgtNodeOf :: "apiID ⇒ (state, act, out) trans ⇒ apiID" where
  "tgtNodeOf _ (Trans s (COMact (comSendServerReq uID p aID reqInfo)) ou s') = aID"
| "tgtNodeOf _ (Trans s (COMact (comReceiveClientReq aID reqInfo)) ou s') = aID"
| "tgtNodeOf _ (Trans s (COMact (comConnectClient uID p aID sp)) ou s') = aID"
| "tgtNodeOf _ (Trans s (COMact (comConnectServer aID sp)) ou s') = aID"
| "tgtNodeOf _ (Trans s (COMact (comSendPost uID p aID nID)) ou s') = aID"
| "tgtNodeOf _ (Trans s (COMact (comReceivePost aID sp nID title text v)) ou s') = aID"
| "tgtNodeOf _ (Trans s (COMact (comSendCreateOFriend uID p aID uID')) ou s') = aID"
| "tgtNodeOf _ (Trans s (COMact (comReceiveCreateOFriend aID sp uid uid')) ou s') = aID"
| "tgtNodeOf _ (Trans s (COMact (comSendDeleteOFriend uID p aID uID')) ou s') = aID"
| "tgtNodeOf _ (Trans s (COMact (comReceiveDeleteOFriend aID sp uid uid')) ou s') = aID"
| "tgtNodeOf _ _ = undefined"

abbreviation validTrans :: "apiID ⇒ (state, act, out) trans ⇒ bool" where
  "validTrans aid ≡ System_Specification.validTrans"

sublocale TS_Network
where istate = "λ_. istate" and validTrans = validTrans and srcOf = "λ_. srcOf" and tgtOf = "λ_. tgtOf"
  and nodes = AIDs and comOf = comOf and tgtNodeOf = tgtNodeOf
  and sync = sync
proof (unfold_locales, goal_cases)
  case (1) show ?case using finite_AIDs . next
  case (2 aid trn)
    from 2 show ?case
      by (cases "(aid, trn)" rule: tgtNodeOf.cases) auto
qed

end

end

Theory Automation_Setup

theory Automation_Setup
  imports System_Specification
begin

lemma add_prop:
  assumes "PROP (T)"
  shows "A ==> PROP (T)"
  using assms .


lemmas exhaust_elim =
   sActt.exhaust[of x, THEN add_prop[where A="a=Sact x"], rotated -1]
   cActt.exhaust[of x, THEN add_prop[where A="a=Cact x"], rotated -1]
   uActt.exhaust[of x, THEN add_prop[where A="a=Uact x"], rotated -1]
   rActt.exhaust[of x, THEN add_prop[where A="a=Ract x"], rotated -1]
   lActt.exhaust[of x, THEN add_prop[where A="a=Lact x"], rotated -1]
   comActt.exhaust[of x, THEN add_prop[where A="a=COMact x"], rotated -1]
  for x a


lemma state_cong:
fixes s::state
assumes
"pendingUReqs s = pendingUReqs s1 ∧ userReq s = userReq s1 ∧ userIDs s = userIDs s1 ∧
 postIDs s = postIDs s1 ∧ admin s = admin s1 ∧
 user s = user s1 ∧ pass s = pass s1 ∧ pendingFReqs s = pendingFReqs s1 ∧ friendReq s = friendReq s1 ∧ friendIDs s = friendIDs s1 ∧
 sentOuterFriendIDs s = sentOuterFriendIDs s1 ∧
 recvOuterFriendIDs s = recvOuterFriendIDs s1 ∧
 post s = post s1 ∧
 owner s = owner s1 ∧ vis s = vis s1 ∧
 pendingSApiReqs s = pendingSApiReqs s1 ∧ sApiReq s = sApiReq s1 ∧ serverApiIDs s = serverApiIDs s1 ∧ serverPass s = serverPass s1 ∧
 outerPostIDs s = outerPostIDs s1 ∧ outerPost s = outerPost s1 ∧
 outerOwner s = outerOwner s1 ∧ outerVis s = outerVis s1 ∧
 pendingCApiReqs s = pendingCApiReqs s1 ∧ cApiReq s = cApiReq s1 ∧ clientApiIDs s = clientApiIDs s1 ∧ clientPass s = clientPass s1 ∧
 sharedWith s = sharedWith s1"
shows "s = s1"
using assms apply (cases s, cases s1) by auto

(*
lemma Paper_dest_conv:
  "(p =
        Paper title abstract content reviews dis decs fcontent) ⟷
  title = titlePaper p ∧
  abstract = abstractPaper p ∧
  content = contentPaper p ∧
  reviews = reviewsPaper p ∧
  dis = disPaper p ∧
  decs = decsPaper p ∧
  fcontent = fcontentPaper p
  "
  by (cases p) auto
*)

end

Theory Safety_Properties

section ‹Safety properties ›

text ‹Here we prove some safety properties (state invariants) for a CoSMeDis
node that are needed in the proof of BD Security properties.
›

theory Safety_Properties
  imports
    Automation_Setup
begin

declare Let_def[simp]
declare if_splits[split]
declare IDsOK_def[simp]

lemmas eff_defs = s_defs c_defs d_defs u_defs
lemmas obs_defs = r_defs l_defs
lemmas effc_defs = eff_defs com_defs
lemmas all_defs = effc_defs obs_defs

declare sstep_Cons[simp]

lemma Lact_Ract_noStateChange[simp]:
assumes "a ∈ Lact ` UNIV ∪ Ract ` UNIV"
shows "snd (step s a) = s"
using assms by (cases a) auto

lemma Lact_Ract_noStateChange_set:
assumes "set al ⊆ Lact ` UNIV ∪ Ract ` UNIV"
shows "snd (sstep s al) = s"
using assms by (induct al) (auto split: prod.splits)

lemma reach_postIDs_persist:
"pID ∈∈ postIDs s ⟹ step s a = (ou,s') ⟹ pID ∈∈ postIDs s'"
apply (cases a)
  subgoal for x1 apply(cases x1, auto simp: effc_defs) .
  subgoal for x2 apply(cases x2, auto simp: effc_defs) .
  subgoal for x3 apply(cases x3, auto simp: effc_defs) .
  subgoal for x4 apply(cases x4, auto simp: effc_defs) .
  subgoal by auto
  subgoal by auto
  subgoal for x7 apply(cases x7, auto simp: effc_defs) .
done

lemma userOfA_not_userIDs_outErr:
"∃ uid. userOfA a = Some uid ∧ ¬ uid ∈∈ userIDs s ⟹
 ∀ aID uID p name. a ≠ Sact (sSys uID p) ⟹
 ∀ uID name. a ≠ Cact (cNUReq uID name) ⟹
 fst (step s a) = outErr"
apply (cases a)
  subgoal for x1 apply(cases x1, auto simp: all_defs) .
  subgoal for x2 apply(cases x2, auto simp: all_defs) .
  subgoal for x3 apply(cases x3, auto simp: all_defs) .
  subgoal for x4 apply(cases x4, auto simp: all_defs) .
  subgoal for x5 apply(cases x5, auto simp: all_defs) .
  subgoal for x6 apply(cases x6, auto simp: all_defs) .
  subgoal for x7 apply(cases x7, auto simp: all_defs) .
done

lemma reach_vis: "reach s ⟹ vis s pID ∈ {FriendV, PublicV}"
proof (induction rule: reach_step_induct)
  case (Step s a) then show ?case proof (cases a)
     case (Sact sAct) with Step show ?thesis
     apply (cases sAct) by (auto simp add: s_defs)
  next
    case (Cact cAct) with Step show ?thesis
    apply (cases cAct) by (auto simp add: c_defs)
  next
    case (Dact dAct) with Step show ?thesis
    apply (cases dAct) by (auto simp add: d_defs)
  next
    case (Uact uAct) with Step show ?thesis
    apply (cases uAct) by (auto simp add: u_defs)
  next
    case (COMact comAct) with Step show ?thesis apply (cases comAct)
    by (auto simp add: com_defs)
  qed auto
qed (auto simp add: istate_def)

lemma reach_not_postIDs_emptyPost:
"reach s ⟹ PID ∉ set (postIDs s) ⟹ post s PID = emptyPost"
proof (induction rule: reach_step_induct)
  case (Step s a) then show ?case proof (cases a)
     case (Sact sAct) with Step show ?thesis
     apply (cases sAct) by (auto simp add: s_defs)
  next
    case (Cact cAct) with Step show ?thesis
    apply (cases cAct) by (auto simp add: c_defs)
  next
    case (Dact dAct) with Step show ?thesis
    apply (cases dAct) by (auto simp add: d_defs)
  next
    case (Uact uAct) with Step show ?thesis
    apply (cases uAct) by (auto simp add: u_defs)
  next
    case (COMact comAct) with Step show ?thesis apply (cases comAct)
    by (auto simp add: com_defs)
  qed auto
qed (auto simp add: istate_def)

lemma reach_not_postIDs_friendV:
"reach s ⟹ PID ∉ set (postIDs s) ⟹ vis s PID = FriendV"
proof (induction rule: reach_step_induct)
  case (Step s a) then show ?case proof (cases a)
     case (Sact sAct) with Step show ?thesis
     apply (cases sAct) by (auto simp add: s_defs)
  next
    case (Cact cAct) with Step show ?thesis
    apply (cases cAct) by (auto simp add: c_defs)
  next
    case (Dact dAct) with Step show ?thesis
    apply (cases dAct) by (auto simp add: d_defs)
  next
    case (Uact uAct) with Step show ?thesis
    apply (cases uAct) by (auto simp add: u_defs)
  next
    case (COMact comAct) with Step show ?thesis apply (cases comAct)
    by (auto simp add: com_defs)
  qed auto
qed (auto simp add: istate_def)


(* Would only work if we new that the same property holds
for what is being received:
lemma reach_outerVis: "reach s ⟹ outerVis s aID pID ∈ {FriendV, PublicV}"
proof (induction rule: reach_step_induct)
  case (Step s a) then show ?case proof (cases a)
     case (Sact sAct) with Step show ?thesis
     apply (cases sAct) by (auto simp add: s_defs)
  next
    case (Cact cAct) with Step show ?thesis
    apply (cases cAct) by (auto simp add: c_defs)
  next
    case (Dact dAct) with Step show ?thesis
    apply (cases dAct) by (auto simp add: d_defs)
  next
    case (Uact uAct) with Step show ?thesis
    apply (cases uAct) by (auto simp add: u_defs)
  next
    case (COMact comAct) with Step show ?thesis apply (cases comAct)
    apply (auto simp add: com_defs fun_upd2_def)
  qed auto
qed (auto simp add: istate_def)
*)

lemma reach_owner_userIDs: "reach s ⟹ pID ∈∈ postIDs s ⟹ owner s pID ∈∈ userIDs s"
proof (induction rule: reach_step_induct)
  case (Step s a) then show ?case proof (cases a)
     case (Sact sAct) with Step show ?thesis
     apply (cases sAct) by (auto simp add: s_defs)
  next
    case (Cact cAct) with Step show ?thesis
    apply (cases cAct) by (auto simp add: c_defs)
  next
    case (Dact dAct) with Step show ?thesis
    apply (cases dAct) by (auto simp add: d_defs)
  next
    case (Uact uAct) with Step show ?thesis
    apply (cases uAct) by (auto simp add: u_defs)
  next
    case (COMact comAct) with Step show ?thesis apply (cases comAct)
    by (auto simp add: com_defs)
  qed auto
qed (auto simp add: istate_def)

lemma reach_admin_userIDs: "reach s ⟹ uID ∈∈ userIDs s ⟹ admin s ∈∈ userIDs s"
proof (induction rule: reach_step_induct)
  case (Step s a) then show ?case proof (cases a)
     case (Sact sAct) with Step show ?thesis
     apply (cases sAct) by (auto simp add: s_defs)
  next
    case (Cact cAct) with Step show ?thesis
    apply (cases cAct) by (auto simp add: c_defs)
  next
    case (Dact dAct) with Step show ?thesis
    apply (cases dAct) by (auto simp add: d_defs)
  next
    case (Uact uAct) with Step show ?thesis
    apply (cases uAct) by (auto simp add: u_defs)
  next
    case (COMact comAct) with Step show ?thesis apply (cases comAct)
    by (auto simp add: com_defs)
  qed auto
qed (auto simp add: istate_def)

lemma reach_pendingUReqs_distinct: "reach s ⟹ distinct (pendingUReqs s)"
proof (induction rule: reach_step_induct)
  case (Step s a) then show ?case proof (cases a)
    case (Sact sAct) with Step show ?thesis by (cases sAct) (auto simp add: s_defs) next
    case (Cact cAct) with Step show ?thesis by (cases cAct) (auto simp add: c_defs) next
    case (Dact dAct) with Step show ?thesis by (cases dAct) (auto simp add: d_defs) next
    case (Uact uAct) with Step show ?thesis by (cases uAct) (auto simp add: u_defs) next
    case (COMact comAct) with Step show ?thesis by (cases comAct) (auto simp add: com_defs)
  qed auto
qed (auto simp: istate_def)

lemma reach_pendingUReqs:
"reach s ⟹ uid ∈∈ pendingUReqs s ⟹ uid ∉ set (userIDs s) ∧ admin s ∈∈ userIDs s"
proof (induction rule: reach_step_induct)
  case (Step s a) then show ?case proof (cases a)
    case (Sact sAct) with Step show ?thesis by (cases sAct) (auto simp add: s_defs) next
    case (Cact cAct)
      with Step reach_pendingUReqs_distinct show ?thesis
        by (cases cAct) (auto simp add: c_defs) next
    case (Dact dAct) with Step show ?thesis by (cases dAct) (auto simp add: d_defs) next
    case (Uact uAct) with Step show ?thesis by (cases uAct) (auto simp add: u_defs) next
    case (COMact comAct) with Step show ?thesis by (cases comAct) (auto simp add: com_defs)
  qed auto
qed (auto simp: istate_def)

lemma reach_friendIDs_symmetric:
"reach s ⟹ uID1 ∈∈ friendIDs s uID2 ⟷ uID2 ∈∈ friendIDs s uID1"
proof (induction rule: reach_step_induct)
  case (Step s a) then show ?case proof (cases a)
    case (Sact sAct) with Step show ?thesis by (cases sAct) (auto simp add: s_defs) next
    case (Cact cAct) with Step show ?thesis by (cases cAct) (auto simp add: c_defs ) next
    case (Dact dAct) with Step show ?thesis by (cases dAct) (auto simp add: d_defs ) next
    case (Uact uAct) with Step show ?thesis by (cases uAct) (auto simp add: u_defs) next
    case (COMact comAct) with Step show ?thesis by (cases comAct) (auto simp add: com_defs)
  qed auto
qed (auto simp add: istate_def)

(* No longer holds:
lemma friendIDs_mono:
assumes "step s a = (ou, s')"
and "uid ∈∈ friendIDs s uid'"
shows "uid ∈∈ friendIDs s' uid'"
using assms proof (cases a)
  case (Sact sAct) with assms show ?thesis by (cases sAct) (auto simp add: s_defs) next
  case (Cact cAct) with assms show ?thesis by (cases cAct) (auto simp add: c_defs ) next
  case (Dact dAct) with assms show ?thesis by (cases dAct) (auto simp add: d_defs ) next
  case (Uact uAct) with assms show ?thesis by (cases uAct) (auto simp add: u_defs) next
  case (COMact comAct) with assms show ?thesis by (cases comAct) (auto simp add: com_defs)
qed auto
*)

lemma reach_distinct_friends_reqs:
assumes "reach s"
shows "distinct (friendIDs s uid)" and "distinct (pendingFReqs s uid)"
  and "distinct (sentOuterFriendIDs s uid)" and "distinct (recvOuterFriendIDs s uid)"
  and "uid' ∈∈ pendingFReqs s uid ⟹ uid' ∉ set (friendIDs s uid)"
  and "uid' ∈∈ pendingFReqs s uid ⟹ uid ∉ set (friendIDs s uid')"
using assms proof (induction arbitrary: uid uid' rule: reach_step_induct)
  case Istate
    fix uid uid'
    show "distinct (friendIDs istate uid)" and "distinct (pendingFReqs istate uid)"
     and "distinct (sentOuterFriendIDs istate uid)" and "distinct (recvOuterFriendIDs istate uid)"
     and "uid' ∈∈ pendingFReqs istate uid ⟹ uid' ∉ set (friendIDs istate uid)"
     and "uid' ∈∈ pendingFReqs istate uid ⟹ uid ∉ set (friendIDs istate uid')"
      unfolding istate_def by auto
next
  case (Step s a)
    have s': "reach (snd (step s a))" using reach_step[OF Step(1)] .
    { fix uid uid'
      have "distinct (friendIDs (snd (step s a)) uid) ∧ distinct (pendingFReqs (snd (step s a)) uid)
          ∧ distinct (sentOuterFriendIDs (snd (step s a)) uid)
          ∧ distinct (recvOuterFriendIDs (snd (step s a)) uid)
          ∧ (uid' ∈∈ pendingFReqs (snd (step s a)) uid ⟶ uid' ∉ set (friendIDs (snd (step s a)) uid))"
      proof (cases a)
        case (Sact sa) with Step show ?thesis by (cases sa) (auto simp add: s_defs) next
        case (Cact ca) with Step show ?thesis by (cases ca) (auto simp add: c_defs) next
        case (Dact da) with Step show ?thesis by (cases da) (auto simp add: d_defs distinct_removeAll) next
        case (Uact ua) with Step show ?thesis by (cases ua) (auto simp add: u_defs) next
        case (Ract ra) with Step show ?thesis by auto next
        case (Lact ra) with Step show ?thesis by auto next
        case (COMact ca) with Step show ?thesis by (cases ca) (auto simp add: com_defs) next
      qed
    } note goal = this
    fix uid uid'
    from goal show "distinct (friendIDs (snd (step s a)) uid)"
               and "distinct (pendingFReqs (snd (step s a)) uid)"
               and "distinct (sentOuterFriendIDs (snd (step s a)) uid)"
               and "distinct (recvOuterFriendIDs (snd (step s a)) uid)"
 by auto
    assume "uid' ∈∈ pendingFReqs (snd (step s a)) uid"
    with goal show "uid' ∉ set (friendIDs (snd (step s a)) uid)" by auto
    then show "uid ∉ set (friendIDs (snd (step s a)) uid')"
      using reach_friendIDs_symmetric[OF s'] by simp
qed

lemma remove1_in_set: "x ∈∈ remove1 y xs ⟹ x ∈∈ xs"
by (induction xs) auto

lemma reach_IDs_used_IDsOK[rule_format]:
assumes "reach s"
shows "uid ∈∈ pendingFReqs s uid' ⟶ IDsOK s [uid, uid'] [] [] []" (is ?p)
and "uid ∈∈ friendIDs s uid' ⟶ IDsOK s [uid, uid'] [] [] []" (is ?f)
using assms proof -
  from assms have "uid ∈∈ pendingFReqs s uid' ∨ uid ∈∈ friendIDs s uid'
               ⟶ IDsOK s [uid, uid'] [] [] []"
  proof (induction rule: reach_step_induct)
    case Istate then show ?case by (auto simp add: istate_def)
  next
    case (Step s a) then show ?case proof (cases a)
      case (Sact sa) with Step show ?thesis by (cases sa) (auto simp: s_defs) next
      case (Cact ca) with Step show ?thesis by (cases ca) (auto simp: c_defs intro: remove1_in_set) next
      case (Dact da) with Step show ?thesis by (cases da) (auto simp: d_defs) next
      case (Uact ua) with Step show ?thesis by (cases ua) (auto simp: u_defs) next
      case (COMact ca) with Step show ?thesis by (cases ca) (auto simp: com_defs)
    qed auto
  qed
  then show ?p and ?f by auto
qed

lemma reach_AID_used_valid:
assumes "reach s"
and "aid ∈∈ serverApiIDs s ∨ aid ∈∈ clientApiIDs s ∨ aid ∈∈ pendingSApiReqs s ∨ aid ∈∈ pendingCApiReqs s"
shows "admin s ∈∈ userIDs s"
using assms proof (induction rule: reach_step_induct)
  case Istate then show ?case by (auto simp: istate_def)
next
  case (Step s a) then show ?case proof (cases a)
    case (Sact sa) with Step show ?thesis by (cases sa) (auto simp: s_defs) next
    case (Cact ca) with Step show ?thesis by (cases ca) (auto simp: c_defs) next
    case (Dact da) with Step show ?thesis by (cases da) (auto simp: d_defs) next
    case (Uact ua) with Step show ?thesis by (cases ua) (auto simp: u_defs) next
    case (COMact ca) with Step show ?thesis by (cases ca) (auto simp: com_defs intro: remove1_in_set)
  qed auto
qed

lemma IDs_mono[rule_format]:
assumes "step s a = (ou, s')"
shows "uid ∈∈ userIDs s ⟶ uid ∈∈ userIDs s'" (is "?u")
and "nid ∈∈ postIDs s ⟶ nid ∈∈ postIDs s'" (is "?n")
and "aid ∈∈ clientApiIDs s ⟶ aid ∈∈ clientApiIDs s'" (is "?c")
and "sid ∈∈ serverApiIDs s ⟶ sid ∈∈ serverApiIDs s'" (is "?s")
and "nid ∈∈ outerPostIDs s aid ⟶ nid ∈∈ outerPostIDs s' aid" (is "?o")
proof -
  from assms have "?u ∧ ?n ∧ ?c ∧ ?s ∧ ?o" proof (cases a)
    case (Sact sa) with assms show ?thesis by (cases sa) (auto simp add: s_defs) next
    case (Cact ca) with assms show ?thesis by (cases ca) (auto simp add: c_defs) next
    case (Dact da) with assms show ?thesis by (cases da) (auto simp add: d_defs) next
    case (Uact ua) with assms show ?thesis by (cases ua) (auto simp add: u_defs) next
    case (COMact ca) with assms show ?thesis by (cases ca) (auto simp add: com_defs)
  qed (auto)
  then show "?u" "?n" "?c" "?s" "?o" by auto
qed

lemma IDsOK_mono:
assumes "step s a = (ou, s')"
and "IDsOK s uIDs pIDs saID_pIDs_s caIDs"
shows "IDsOK s' uIDs pIDs saID_pIDs_s caIDs"
using IDs_mono[OF assms(1)] assms(2)
by (auto simp add: list_all_iff)


lemma step_outerFriendIDs_idem:
assumes "step s a = (ou, s')"
and "∀uID p aID uID'. a ≠ COMact (comSendCreateOFriend uID p aID uID') ∧
                      a ≠ COMact (comReceiveCreateOFriend aID p uID uID') ∧
                      a ≠ COMact (comSendDeleteOFriend uID p aID uID') ∧
                      a ≠ COMact (comReceiveDeleteOFriend aID p uID uID')"
shows "sentOuterFriendIDs s' = sentOuterFriendIDs s" (is ?sent)
  and "recvOuterFriendIDs s' = recvOuterFriendIDs s" (is ?recv)
proof -
  have "?sent ∧ ?recv" using assms proof (cases a)
    case (Sact sa) with assms show ?thesis by (cases sa) (auto simp add: s_defs) next
    case (Cact ca) with assms show ?thesis by (cases ca) (auto simp add: c_defs) next
    case (Dact da) with assms show ?thesis by (cases da) (auto simp add: d_defs) next
    case (Uact ua) with assms show ?thesis by (cases ua) (auto simp add: u_defs) next
    case (COMact ca) with assms show ?thesis by (cases ca) (auto simp add: com_defs)
  qed auto
  then show "?sent" and "?recv" by auto
qed

lemma istate_sSys:
assumes "step istate a = (ou, s')"
obtains uid p where "a = Sact (sSys uid p)"
      | "s' = istate"
using assms proof (cases a)
  case (Sact sa) with assms show ?thesis by (cases sa) (auto intro: that) next
  case (Cact ca) with assms that(2) show ?thesis by (cases ca) (auto simp add: c_defs istate_def) next
  case (Dact da) with assms that(2) show ?thesis by (cases da) (auto simp add: d_defs istate_def) next
  case (Uact ua) with assms that(2) show ?thesis by (cases ua) (auto simp add: u_defs istate_def) next
  case (COMact ca) with assms that(2) show ?thesis by (cases ca) (auto simp add: com_defs istate_def) next
  case (Ract ra) with assms that(2) show ?thesis by (cases ra) (auto simp add: r_defs istate_def) next
  case (Lact la) with assms that(2) show ?thesis by (cases la) (auto simp add: l_defs istate_def)
qed


end
>

Theory Post_Intro

theory Post_Intro
  imports "../Safety_Properties"
begin

section ‹Post confidentiality›

text ‹\label{sec:post}
We verify the following BD Security property of the CoSMeDis network:

\ \\
Given a coalition consisting of groups of users ‹UIDs j› from multiple nodes ‹j›
and given a post ‹PID› at node ‹i›,

the coalition cannot learn anything about the updates to this post

beyond those updates performed while or last before one of the following holds:

(1) Some user in ‹UIDs i› is the admin at node ‹i›,
is the owner of ‹PID› or is friends with the owner of ‹PID›

(2) ‹PID› is marked as public

unless some user in ‹UIDs j› for a node ‹j› different than ‹i› is admin of node ‹j›
or is remote friend with the owner of ‹PID›.\footnote{So ‹UIDs› is a function from node
identifiers (called API IDs in this formalization) to sets of user IDs.
We will write ‹AID› instead of ‹i› (which will be fixed in our locales)
and ‹aid› instead of ‹j›.}

\ \\
As explained in \cite{cosmedis-SandP2017}, in order to prove this property
for the CoSMeDis network, we compose BD security properties of
individual CoSMeDis nodes. When formulating the individual node properties, we will
distinguish between the \emph{secret issuer} node ‹i› and the (potential)
\emph{secret receiver} nodes: all nodes different from ‹i›. Consequently, we will
have two BD security properties -- for issuers and for receivers -- proved in their
corresponding subsections. Then we prove BD Security for the (binary) composition of an
issuer and a receiver node, and finally we prove BD Security for the n-ary composition
(of an entire CoSMeDis network of nodes).

Described above is the property in a form that employs a dynamic trigger
(i.e., an inductive bound that incorporates an iterated trigger) for the secret issuer
node.
However, the first subsections of this section cover the static version of this (multi-node)
property, corresponding to a static BD security property for the secret issuer.
The dynamic version is covered after that, in a dedicated subsection.

Finally, we lift the above BD security property, which refers to a single secret source,
i.e., a post at some node, to simultaneous BD Security for two independent secret sources,
i.e., two different posts at two (possibly different) nodes. For this, we use the
BD Security system compositionality and transport theorems formalized in the AFP entry
\cite{BDSecuritycomp-AFP}.
More details about this approach can be found in \cite{cosmedis-SandP2017};
in particular, Appendix A from that paper discusses the transport theorem.
›

end
le>

Theory Post_Observation_Setup_ISSUER

(* Strengthened observation setup, customized for post confidentiality *)
theory Post_Observation_Setup_ISSUER
  imports Post_Intro
begin

subsection ‹Confidentiality for a secret issuer node›


text ‹\label{sec:post-issuer}
We verify that a group of users of a given node ‹i›
can learn nothing about the updates to the content of a post
‹PID› located at that node beyond the existence of an update
unless one of them is the admin or the owner of ‹PID›,
or becomes friends with the owner,
or ‹PID› is marked as public. This is formulated as a BD Security
property and is proved by unwinding.

See \cite{cosmedis-SandP2017} for more details.
›

subsubsection ‹Observation setup›

(* *)
type_synonym obs = "act * out"

(* The observers are an arbitrary, but fixed set of users *)
locale Fixed_UIDs = fixes UIDs :: "userID set"
(* The secret is PID: *)
locale Fixed_PID = fixes PID :: "postID"

locale ObservationSetup_ISSUER = Fixed_UIDs + Fixed_PID
begin

(*  *)
fun γ :: "(state,act,out) trans ⇒ bool" where
"γ (Trans _ a _ _) ⟷
   (∃ uid. userOfA a = Some uid ∧ uid ∈ UIDs)
   ∨
   (∃ca. a = COMact ca)
   ∨
   (∃uid p. a = Sact (sSys uid p))"

(* Note: the passwords don't really have to be purged (since identity theft is not
considered in the first place); however, purging passwords looks more sane. *)

(* Purging the password in starting actions: *)
fun sPurge :: "sActt ⇒ sActt" where
"sPurge (sSys uid pwd) = sSys uid emptyPass"

(* Purging communicating actions: user-password information is removed.
  Note: comReceivePost is not affected by the purging, in that post content
  is not removed; this only happens on the receiving end.
  (Also, nothing to purge in comSendPost either -- the output will be purged here, since
   only the output contains an actual post.)


  Note: server-password info is not purged --todo: discuss this.  *)
fun comPurge :: "comActt ⇒ comActt" where
 "comPurge (comSendServerReq uID p aID reqInfo) = comSendServerReq uID emptyPass aID reqInfo"
|"comPurge (comConnectClient uID p aID sp) = comConnectClient uID emptyPass aID sp"
|"comPurge (comConnectServer aID sp) = comConnectServer aID sp"
|"comPurge (comSendPost uID p aID pID) = comSendPost uID emptyPass aID pID"
|"comPurge (comSendCreateOFriend uID p aID uID') = comSendCreateOFriend uID emptyPass aID uID'"
|"comPurge (comSendDeleteOFriend uID p aID uID') = comSendDeleteOFriend uID emptyPass aID uID'"
|"comPurge ca = ca"

(* Purging outputs: post content for PID
  is removed from the post sending outputs
  (Again, server-password info is not purged.)   *)
fun outPurge :: "out ⇒ out" where
 "outPurge (O_sendPost (aID, sp, pID, pst, uID, vs)) =
  (let pst' = (if pID = PID then emptyPost else pst)
   in O_sendPost (aID, sp, pID, pst', uID, vs))"
|"outPurge ou = ou"

fun g :: "(state,act,out)trans ⇒ obs" where
 "g (Trans _ (Sact sa) ou _) = (Sact (sPurge sa), outPurge ou)"
|"g (Trans _ (COMact ca) ou _) = (COMact (comPurge ca), outPurge ou)"
|"g (Trans _ a ou _) = (a,ou)"

lemma comPurge_simps:
  "comPurge ca = comSendServerReq uID p aID reqInfo ⟷ (∃p'. ca = comSendServerReq uID p' aID reqInfo ∧ p = emptyPass)"
  "comPurge ca = comReceiveClientReq aID reqInfo ⟷ ca = comReceiveClientReq aID reqInfo"
  "comPurge ca = comConnectClient uID p aID sp ⟷ (∃p'. ca = comConnectClient uID p' aID sp ∧ p = emptyPass)"
  "comPurge ca = comConnectServer aID sp ⟷ ca = comConnectServer aID sp"
  "comPurge ca = comReceivePost aID sp nID nt uID v ⟷ ca = comReceivePost aID sp nID nt uID v"
  "comPurge ca = comSendPost uID p aID nID ⟷ (∃p'. ca = comSendPost uID p' aID nID ∧ p = emptyPass)"
  "comPurge ca = comSendCreateOFriend uID p aID uID' ⟷ (∃p'. ca = comSendCreateOFriend uID p' aID uID' ∧ p = emptyPass)"
  "comPurge ca = comReceiveCreateOFriend aID cp uID uID' ⟷ ca = comReceiveCreateOFriend aID cp uID uID'"
  "comPurge ca = comSendDeleteOFriend uID p aID uID' ⟷ (∃p'. ca = comSendDeleteOFriend uID p' aID uID' ∧ p = emptyPass)"
  "comPurge ca = comReceiveDeleteOFriend aID cp uID uID' ⟷ ca = comReceiveDeleteOFriend aID cp uID uID'"
by (cases ca; auto)+

lemma outPurge_simps[simp]:
  "outPurge ou = outErr ⟷ ou = outErr"
  "outPurge ou = outOK ⟷ ou = outOK"
  "outPurge ou = O_sendServerReq ossr ⟷ ou = O_sendServerReq ossr"
  "outPurge ou = O_connectClient occ ⟷ ou = O_connectClient occ"
  "outPurge ou = O_sendPost (aid, sp, pid, pst', uid, vs) ⟷ (∃pst.
     ou = O_sendPost (aid, sp, pid, pst, uid, vs) ∧
     pst' = (if pid = PID then emptyPost else pst))"
  "outPurge ou = O_sendCreateOFriend oscf ⟷ ou = O_sendCreateOFriend oscf"
  "outPurge ou = O_sendDeleteOFriend osdf ⟷ ou = O_sendDeleteOFriend osdf"
by (cases ou; auto simp: ObservationSetup_ISSUER.outPurge.simps)+


lemma g_simps:
  "g (Trans s a ou s') = (COMact (comSendServerReq uID p aID reqInfo), O_sendServerReq ossr)
⟷ (∃p'. a = COMact (comSendServerReq uID p' aID reqInfo) ∧ p = emptyPass ∧ ou = O_sendServerReq ossr)"
  "g (Trans s a ou s') = (COMact (comReceiveClientReq aID reqInfo), outOK)
⟷ a = COMact (comReceiveClientReq aID reqInfo) ∧ ou = outOK"
  "g (Trans s a ou s') = (COMact (comConnectClient uID p aID sp), O_connectClient occ)
⟷ (∃p'. a = COMact (comConnectClient uID p' aID sp) ∧ p = emptyPass ∧ ou = O_connectClient occ)"
  "g (Trans s a ou s') = (COMact (comConnectServer aID sp), outOK)
⟷ a = COMact (comConnectServer aID sp) ∧ ou = outOK"
  "g (Trans s a ou s') = (COMact (comReceivePost aID sp nID nt uID v), outOK)
⟷ a = COMact (comReceivePost aID sp nID nt uID v) ∧ ou = outOK"
  "g (Trans s a ou s') = (COMact (comSendPost uID p aID nID), O_sendPost (aid, sp, pid, pst', uid, vs))
⟷ (∃pst p'. a = COMact (comSendPost uID p' aID nID) ∧ p = emptyPass ∧ ou = O_sendPost (aid, sp, pid, pst, uid, vs) ∧ pst' = (if pid = PID then emptyPost else pst))"
  "g (Trans s a ou s') = (COMact (comSendCreateOFriend uID p aID uID'), O_sendCreateOFriend (aid, sp, uid, uid'))
⟷ (∃p'. a = (COMact (comSendCreateOFriend uID p' aID uID')) ∧ p = emptyPass ∧ ou = O_sendCreateOFriend (aid, sp, uid, uid'))"
  "g (Trans s a ou s') = (COMact (comReceiveCreateOFriend aID cp uID uID'), outOK)
⟷ a = COMact (comReceiveCreateOFriend aID cp uID uID') ∧ ou = outOK"
  "g (Trans s a ou s') = (COMact (comSendDeleteOFriend uID p aID uID'), O_sendDeleteOFriend (aid, sp, uid, uid'))
⟷ (∃p'. a = COMact (comSendDeleteOFriend uID p' aID uID') ∧ p = emptyPass ∧ ou = O_sendDeleteOFriend (aid, sp, uid, uid'))"
  "g (Trans s a ou s') = (COMact (comReceiveDeleteOFriend aID cp uID uID'), outOK)
⟷ a = COMact (comReceiveDeleteOFriend aID cp uID uID') ∧ ou = outOK"
by (cases a; auto simp: comPurge_simps)+

end

end
e>

Theory Post_Unwinding_Helper_ISSUER

theory Post_Unwinding_Helper_ISSUER
  imports Post_Observation_Setup_ISSUER
begin

locale Issuer_State_Equivalence_Up_To_PID = Fixed_PID
begin

subsubsection ‹Unwinding helper lemmas and definitions›

(* Auxiliary notion: two functions are equal everywhere but on the NIC (content) of
   the value corresponding to PID *)
definition eeqButPID where
"eeqButPID psts psts1 ≡
 ∀ pid. if pid = PID then True else psts pid = psts1 pid"

lemmas eeqButPID_intro = eeqButPID_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eeqButPID_eeq[simp,intro!]: "eeqButPID psts psts"
unfolding eeqButPID_def by auto

lemma eeqButPID_sym:
assumes "eeqButPID psts psts1" shows "eeqButPID psts1 psts"
using assms unfolding eeqButPID_def by auto

lemma eeqButPID_trans:
assumes "eeqButPID psts psts1" and "eeqButPID psts1 psts2" shows "eeqButPID psts psts2"
using assms unfolding eeqButPID_def by (auto split: if_splits)

lemma eeqButPID_cong:
assumes "eeqButPID psts psts1"
and "pid = PID ⟹ eqButT uu uu1"
and "pid ≠ PID ⟹ uu = uu1"
shows "eeqButPID (psts (pid := uu)) (psts1(pid := uu1))"
using assms unfolding eeqButPID_def by (auto split: if_splits)

(*
lemma eeqButPID_eqButT:
"eeqButPID psts psts1 ⟹ eqButT (psts PID) (psts1 PID)"
unfolding eeqButPID_def by (auto split: if_splits)
*)

lemma eeqButPID_not_PID:
"⟦eeqButPID psts psts1; pid ≠ PID⟧ ⟹ psts pid = psts1 pid"
unfolding eeqButPID_def by (auto split: if_splits)

(*
lemma eeqButPID_postSelectors:
"eeqButPID psts psts1 ⟹
 titlePost (psts pid) = titlePost (psts1 pid) ∧
 imgPost (psts pid) = imgPost (psts1 pid) ∧
 visPost (psts pid) = visPost (psts1 pid)"
unfolding eeqButPID_def by (metis eqButT.simps)
*)

lemma eeqButPID_toEq:
assumes "eeqButPID psts psts1"
shows "psts (PID := pid) =
       psts1 (PID := pid)"
using eeqButPID_not_PID[OF assms] by auto

lemma eeqButPID_update_post:
assumes "eeqButPID psts psts1"
shows "eeqButPID (psts (pid := pst)) (psts1 (pid := pst))"
using eeqButPID_not_PID[OF assms]
using assms unfolding eeqButPID_def by auto


(* lists two pairs (apiID, boolean flag) are equal save for the boolean flag: *)
fun eqButF :: "(apiID × bool) list ⇒ (apiID × bool) list ⇒ bool" where
"eqButF aID_bl aID_bl1 = (map fst aID_bl = map fst aID_bl1)"

lemma eqButF_eq[simp,intro!]: "eqButF aID_bl aID_bl"
by auto

lemma eqButF_sym:
assumes "eqButF aID_bl aID_bl1"
shows "eqButF aID_bl1 aID_bl"
using assms by auto

lemma eqButF_trans:
assumes "eqButF aID_bl aID_bl1" and "eqButF aID_bl1 aID_bl2"
shows "eqButF aID_bl aID_bl2"
using assms by auto

lemma eqButF_insert2:
"eqButF aID_bl aID_bl1 ⟹
 eqButF (insert2 aID b aID_bl) (insert2 aID b aID_bl1)"
unfolding insert2_def
by simp (smt map_eq_conv o_apply o_id prod.collapse prod.sel(1) split_conv)


(* Auxiliary notion: two functions are equal everywhere but on the second component of NIC of
   the value corresponding to PID, which is a list of pairs *)
definition eeqButPID_F where
"eeqButPID_F sw sw1 ≡
 ∀ pid. if pid = PID then eqButF (sw PID) (sw1 PID) else sw pid = sw1 pid"

lemmas eeqButPID_F_intro = eeqButPID_F_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eeqButPID_F_eeq[simp,intro!]: "eeqButPID_F sw sw"
unfolding eeqButPID_F_def by auto

lemma eeqButPID_F_sym:
assumes "eeqButPID_F sw sw1" shows "eeqButPID_F sw1 sw"
using assms eqButF_sym unfolding eeqButPID_F_def
by presburger

lemma eeqButPID_F_trans:
assumes "eeqButPID_F sw sw1" and "eeqButPID_F sw1 sw2" shows "eeqButPID_F sw sw2"
using assms unfolding eeqButPID_F_def by (auto split: if_splits)

lemma eeqButPID_F_cong:
assumes "eeqButPID_F sw sw1"
and "PID = PID ⟹ eqButF uu uu1"
and "pid ≠ PID ⟹ uu = uu1"
shows "eeqButPID_F (sw (pid := uu)) (sw1(pid := uu1))"
using assms unfolding eeqButPID_F_def by (auto split: if_splits)

lemma eeqButPID_F_eqButF:
"eeqButPID_F sw sw1 ⟹ eqButF (sw PID) (sw1 PID)"
unfolding eeqButPID_F_def by (auto split: if_splits)

lemma eeqButPID_F_not_PID:
"⟦eeqButPID_F sw sw1; pid ≠ PID⟧ ⟹ sw pid = sw1 pid"
unfolding eeqButPID_F_def by (auto split: if_splits)

lemma eeqButPID_F_postSelectors:
"eeqButPID_F sw sw1 ⟹ map fst (sw pid) = map fst (sw1 pid)"
unfolding eeqButPID_F_def by (metis eqButF.simps)

lemma eeqButPID_F_insert2:
"eeqButPID_F sw sw1 ⟹
 eqButF (insert2 aID b (sw PID)) (insert2 aID b (sw1 PID))"
unfolding eeqButPID_F_def using eqButF_insert2 by metis

lemma eeqButPID_F_toEq:
assumes "eeqButPID_F sw sw1"
shows "sw (PID := map (λ (aID,_). (aID,b)) (sw PID)) =
       sw1 (PID := map (λ (aID,_). (aID,b)) (sw1 PID))"
using length_map eeqButPID_F_eqButF[OF assms] eeqButPID_F_not_PID[OF assms]
apply(auto simp: o_def split_def map_replicate_const intro!: map_prod_cong ext)
by (metis length_map)

lemma eeqButPID_F_updateShared:
assumes "eeqButPID_F sw sw1"
shows "eeqButPID_F (sw (pid := aID_b)) (sw1 (pid := aID_b))"
using eeqButPID_F_eqButF[OF assms] eeqButPID_F_not_PID[OF assms]
using assms unfolding eeqButPID_F_def by auto


(* The notion of two states being equal everywhere but on the content of
   the post associated to a given PID and the update status of the PID shareWith info: *)
definition eqButPID :: "state ⇒ state ⇒ bool" where
"eqButPID s s1 ≡
 admin s = admin s1 ∧

 pendingUReqs s = pendingUReqs s1 ∧ userReq s = userReq s1 ∧
 userIDs s = userIDs s1 ∧ user s = user s1 ∧ pass s = pass s1 ∧

 pendingFReqs s = pendingFReqs s1 ∧ friendReq s = friendReq s1 ∧ friendIDs s = friendIDs s1 ∧
 sentOuterFriendIDs s = sentOuterFriendIDs s1 ∧ recvOuterFriendIDs s = recvOuterFriendIDs s1 ∧

 postIDs s = postIDs s1 ∧ admin s = admin s1 ∧
 eeqButPID (post s) (post s1) ∧
 owner s = owner s1 ∧
 vis s = vis s1 ∧

 pendingSApiReqs s = pendingSApiReqs s1 ∧ sApiReq s = sApiReq s1 ∧
 serverApiIDs s = serverApiIDs s1 ∧ serverPass s = serverPass s1 ∧
 outerPostIDs s = outerPostIDs s1 ∧ outerPost s = outerPost s1 ∧
 outerOwner s = outerOwner s1 ∧
 outerVis s = outerVis s1 ∧

 pendingCApiReqs s = pendingCApiReqs s1 ∧ cApiReq s = cApiReq s1 ∧
 clientApiIDs s = clientApiIDs s1 ∧ clientPass s = clientPass s1 ∧
 eeqButPID_F (sharedWith s) (sharedWith s1)"

lemmas eqButPID_intro = eqButPID_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eqButPID_refl[simp,intro!]: "eqButPID s s"
unfolding eqButPID_def by auto

lemma eqButPID_sym:
assumes "eqButPID s s1" shows "eqButPID s1 s"
using assms eeqButPID_sym eeqButPID_F_sym unfolding eqButPID_def by auto

lemma eqButPID_trans:
assumes "eqButPID s s1" and "eqButPID s1 s2" shows "eqButPID s s2"
using assms eeqButPID_trans eeqButPID_F_trans unfolding eqButPID_def
by simp blast

(* Implications from eqButPID, including w.r.t. auxiliary operations: *)
lemma eqButPID_stateSelectors:
"eqButPID s s1 ⟹
 admin s = admin s1 ∧

 pendingUReqs s = pendingUReqs s1 ∧ userReq s = userReq s1 ∧
 userIDs s = userIDs s1 ∧ user s = user s1 ∧ pass s = pass s1 ∧

 pendingFReqs s = pendingFReqs s1 ∧ friendReq s = friendReq s1 ∧ friendIDs s = friendIDs s1 ∧
 sentOuterFriendIDs s = sentOuterFriendIDs s1 ∧ recvOuterFriendIDs s = recvOuterFriendIDs s1 ∧

 postIDs s = postIDs s1 ∧ admin s = admin s1 ∧
 eeqButPID (post s) (post s1) ∧
 owner s = owner s1 ∧
 vis s = vis s1 ∧

 pendingSApiReqs s = pendingSApiReqs s1 ∧ sApiReq s = sApiReq s1 ∧
 serverApiIDs s = serverApiIDs s1 ∧ serverPass s = serverPass s1 ∧
 outerPostIDs s = outerPostIDs s1 ∧ outerPost s = outerPost s1 ∧
 outerOwner s = outerOwner s1 ∧
 outerVis s = outerVis s1 ∧

 pendingCApiReqs s = pendingCApiReqs s1 ∧ cApiReq s = cApiReq s1 ∧
 clientApiIDs s = clientApiIDs s1 ∧ clientPass s = clientPass s1 ∧
 eeqButPID_F (sharedWith s) (sharedWith s1) ∧

 IDsOK s = IDsOK s1"
unfolding eqButPID_def IDsOK_def[abs_def] by auto

(* lemma eqButPID_eqButT:
"eqButPID s s1 ⟹ eqButT (post s PID) (post s1 PID)"
unfolding eqButPID_def using eeqButPID_eqButT by auto *)

lemma eqButPID_not_PID:
"eqButPID s s1 ⟹ pid ≠ PID ⟹ post s pid = post s1 pid"
unfolding eqButPID_def using eeqButPID_not_PID by auto

lemma eqButPID_eqButF:
"eqButPID s s1 ⟹ eqButF (sharedWith s PID) (sharedWith s1 PID)"
unfolding eqButPID_def using eeqButPID_F_eqButF by auto

lemma eqButPID_not_PID_sharedWith:
"eqButPID s s1 ⟹ pid ≠ PID ⟹ sharedWith s pid = sharedWith s1 pid"
unfolding eqButPID_def using eeqButPID_F_not_PID by auto

(* lemma eqButPID_imp0:
assumes "eqButPID s s1" and 1: "pid ≠ PID"
shows "post s pid = post s1 pid"
proof-
  have "eeqButPID (post s) (post s1)"
  using assms using eqButPID_imp by simp
  from eeqButPID_imp(2)[OF this] 1 show ?thesis by auto
qed *)

(*
lemma eqButPID_postSelectors:
assumes "eqButPID s s1"
shows "titlePost (post s pid) = titlePost (post s1 pid) ∧
       imgPost (post s pid) = imgPost (post s1 pid) ∧
       visPost (post s pid) = visPost (post s1 pid)"
using assms unfolding eqButPID_def using eeqButPID_postSelectors by auto
*)

lemma eqButPID_insert2:
"eqButPID s s1 ⟹
 eqButF (insert2 aID b (sharedWith s PID)) (insert2 aID b (sharedWith s1 PID))"
unfolding eqButPID_def using eeqButPID_F_insert2 by metis

lemma eqButPID_actions:
assumes "eqButPID s s1"
shows "listInnerPosts s uid p = listInnerPosts s1 uid p"
using eqButPID_stateSelectors[OF assms] (* eqButPID_postSelectors[OF assms *)
by (auto simp: l_defs intro!: arg_cong2[of _ _ _ _ cmap])

(*
lemma eqButPID_setTextPost:
assumes "eqButPID s s1"
shows "setTextPost (post s PID) pst =
       setTextPost (post s1 PID) pst"
using assms unfolding eqButPID_def using eeqButPID_toEq
by (meson fun_upd_eqD)
*)

lemma eqButPID_update:
assumes "eqButPID s s1"
shows "(post s)(PID := txt) = (post s1)(PID := txt)"
using assms unfolding eqButPID_def using eeqButPID_toEq by auto

lemma eqButPID_update_post:
assumes "eqButPID s s1"
shows "eeqButPID ((post s) (pid := pst)) ((post s1) (pid := pst))"
using assms unfolding eqButPID_def using eeqButPID_update_post by auto

lemma eqButPID_setShared:
assumes "eqButPID s s1"
shows "(sharedWith s) (PID := map (λ (aID,_). (aID,b)) (sharedWith s PID)) =
       (sharedWith s1) (PID := map (λ (aID,_). (aID,b)) (sharedWith s1 PID))"
using assms unfolding eqButPID_def using eeqButPID_F_toEq by auto

lemma eqButPID_updateShared:
assumes "eqButPID s s1"
shows "eeqButPID_F ((sharedWith s) (pid := aID_b)) ((sharedWith s1) (pid := aID_b))"
using assms unfolding eqButPID_def using eeqButPID_F_updateShared by auto


lemma eqButPID_cong[simp]:
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇admin := uu1⦈) (s1 ⦇admin := uu2⦈)"

"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇pendingUReqs := uu1⦈) (s1 ⦇pendingUReqs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇userReq := uu1⦈) (s1 ⦇userReq := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇userIDs := uu1⦈) (s1 ⦇userIDs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇user := uu1⦈) (s1 ⦇user := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇pass := uu1⦈) (s1 ⦇pass := uu2⦈)"

"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇postIDs := uu1⦈) (s1 ⦇postIDs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ eeqButPID uu1 uu2 ⟹ eqButPID (s ⦇post := uu1⦈) (s1 ⦇post := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇owner := uu1⦈) (s1 ⦇owner := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇vis := uu1⦈) (s1 ⦇vis := uu2⦈)"

"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇pendingFReqs := uu1⦈) (s1 ⦇pendingFReqs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇friendReq := uu1⦈) (s1 ⦇friendReq := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇friendIDs := uu1⦈) (s1 ⦇friendIDs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇sentOuterFriendIDs := uu1⦈) (s1 ⦇sentOuterFriendIDs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇recvOuterFriendIDs := uu1⦈) (s1 ⦇recvOuterFriendIDs := uu2⦈)"

"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇pendingSApiReqs := uu1⦈) (s1 ⦇pendingSApiReqs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇sApiReq := uu1⦈) (s1 ⦇sApiReq := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇serverApiIDs := uu1⦈) (s1 ⦇serverApiIDs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇serverPass := uu1⦈) (s1 ⦇serverPass := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇outerPostIDs := uu1⦈) (s1 ⦇outerPostIDs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇outerPost := uu1⦈) (s1 ⦇outerPost := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇outerOwner := uu1⦈) (s1 ⦇outerOwner := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇outerVis := uu1⦈) (s1 ⦇outerVis := uu2⦈)"

"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇pendingCApiReqs := uu1⦈) (s1 ⦇pendingCApiReqs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇cApiReq := uu1⦈) (s1 ⦇cApiReq := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇clientApiIDs := uu1⦈) (s1 ⦇clientApiIDs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇clientPass := uu1⦈) (s1 ⦇clientPass := uu2⦈)"

"⋀ uu1 uu2. eqButPID s s1 ⟹ eeqButPID_F uu1 uu2 ⟹ eqButPID (s ⦇sharedWith := uu1⦈) (s1 ⦇sharedWith:= uu2⦈)"
unfolding eqButPID_def by auto


(* major *) lemma eqButPID_step:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')"
and step1: "step s1 a = (ou1,s1')"
shows "eqButPID s' s1'"
proof -
  note [simp] = all_defs eeqButPID_F_def
  note [intro!] = eqButPID_cong
  note * = step step1 ss1 eqButPID_stateSelectors[OF ss1]
           eqButPID_update[OF ss1] eqButPID_update_post[OF ss1]
           eqButPID_setShared[OF ss1] eqButPID_updateShared[OF ss1]
           eqButPID_insert2[OF ss1]
  then show ?thesis
  proof (cases a)
    case (Sact x1)
    with * show ?thesis by (cases x1) auto
  next
    case (Cact x2)
    with * show ?thesis by (cases x2) auto
  next
    case (Dact x3)
    with * show ?thesis by (cases x3) auto
  next
    case (Uact x4)
    with * show ?thesis
    proof (cases x4)
      case (uPost x21 x22 x23 x24)
      with Uact * show ?thesis by (cases "x23 = PID") auto
    next
      case (uVisPost x31 x32 x33 x34)
      with Uact * show ?thesis by (cases "x33 = PID") auto
    qed auto
  next
    case (COMact x7)
    with * show ?thesis
    proof (cases x7)
      case (comSendPost x61 x62 x63 x64)
      with COMact * show ?thesis by (cases "x64 = PID") auto
    qed auto
  qed auto
qed

end

end
head>

Theory Post_Value_Setup_ISSUER

(* The value setup for post confidentiality *)
theory Post_Value_Setup_ISSUER
  imports
    "../Safety_Properties"
    "Post_Observation_Setup_ISSUER"
    "Post_Unwinding_Helper_ISSUER"
begin

locale Post_ISSUER = ObservationSetup_ISSUER
begin

subsubsection ‹Value setup›


datatype "value" =
  isPVal: PVal post ― ‹updating the post content locally›
| isPValS: PValS (PValS_tgtAPI: apiID) post ― ‹sending the post to another node›

lemma filter_isPValS_Nil: "filter isPValS vl = [] ⟷ list_all isPVal vl"
proof(induct vl)
  case (Cons v vl)
  thus ?case by (cases v) auto
qed auto

fun φ :: "(state,act,out) trans ⇒ bool" where
"φ (Trans _ (Uact (uPost uid p pid pst)) ou _) = (pid = PID ∧ ou = outOK)"
|
"φ (Trans _ (COMact (comSendPost uid p aid pid)) ou _) = (pid = PID ∧ ou ≠ outErr)"
(* Added during strengthening: saying ≠ outErr is simpler than actually describing the output, which essentially
   takes some parameters from the post and some values from the state. *)
|
"φ (Trans s _ _ s') = False"

lemma φ_def2:
shows
"φ (Trans s a ou s') ⟷
 (∃uid p pst. a = Uact (uPost uid p PID pst) ∧ ou = outOK) ∨
 (∃uid p aid. a = COMact (comSendPost uid p aid PID) ∧ ou ≠ outErr)"
by (cases "Trans s a ou s'" rule: φ.cases) auto

lemma uPost_out:
assumes 1: "step s a = (ou,s')" and a: "a = Uact (uPost uid p PID pst)" and 2: "ou = outOK"
shows "uid = owner s PID ∧ p = pass s uid"
using 1 2 unfolding a by (auto simp: u_defs)

lemma comSendPost_out:
assumes 1: "step s a = (ou,s')" and a: "a = COMact (comSendPost uid p aid PID)" and 2: "ou ≠ outErr"
shows "ou = O_sendPost (aid, clientPass s aid, PID, post s PID, owner s PID, vis s PID)
       ∧ uid = admin s ∧ p = pass s (admin s)"
using 1 2 unfolding a by (auto simp: com_defs)

lemma φ_def3:
assumes "step s a = (ou,s')"
shows
"φ (Trans s a ou s') ⟷
 (∃pst. a = Uact (uPost (owner s PID) (pass s (owner s PID)) PID pst) ∧ ou = outOK) ∨
 (∃aid. a = COMact (comSendPost (admin s) (pass s (admin s)) aid PID) ∧
        ou = O_sendPost (aid, clientPass s aid, PID, post s PID, owner s PID, vis s PID))"
unfolding φ_def2(* [OF assms] *)
using comSendPost_out[OF assms] uPost_out[OF assms]
by blast

lemma φ_cases:
assumes "φ (Trans s a ou s')"
and "step s a = (ou, s')"
and "reach s"
obtains
  (UpdateT) uid p pID pst where "a = Uact (uPost uid p PID pst)" "ou = outOK" "p = pass s uid"
                                  "uid = owner s PID"
| (Send) uid p aid where "a = COMact (comSendPost uid p aid PID)" "ou ≠ outErr" "p = pass s uid"
                                  "uid = admin s"
proof -
  from assms(1) obtain uid p pst aid where "(a = Uact (uPost uid p PID pst) ∧ ou = outOK) ∨
                                          (a = COMact (comSendPost uid p aid PID) ∧ ou ≠ outErr)"
    unfolding φ_def2(* [OF assms(2)] *) by auto
  then show thesis proof(elim disjE)
    assume "a = Uact (uPost uid p PID pst) ∧ ou = outOK"
    with assms(2) show thesis by (intro UpdateT) (auto simp: u_defs)
  next
    assume "a = COMact (comSendPost uid p aid PID) ∧ ou ≠ outErr"
    with assms(2) show thesis by (intro Send) (auto simp: com_defs)
  qed
qed


fun f :: "(state,act,out) trans ⇒ value" where
"f (Trans s (Uact (uPost uid p pid pst)) _ s') =
 (if pid = PID then PVal pst else undefined)"
|
"f (Trans s (COMact (comSendPost uid p aid pid)) (O_sendPost (_, _, _, pst, _, _)) s') =
 (if pid = PID then PValS aid pst else undefined)"
|
"f (Trans s _ _ s') = undefined"

sublocale Issuer_State_Equivalence_Up_To_PID .

lemma Uact_uPaperC_step_eqButPID:
assumes a: "a = Uact (uPost uid p PID pst)"
and "step s a = (ou,s')"
shows "eqButPID s s'"
using assms unfolding eqButPID_def eeqButPID_def eeqButPID_F_def
by (auto simp: u_defs split: if_splits)


lemma eqButPID_step_φ_imp:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and φ: "φ (Trans s a ou s')"
shows "φ (Trans s1 a ou1 s1')"
proof-
  have s's1': "eqButPID s' s1'"
  using eqButPID_step local.step ss1 step1 by blast
  show ?thesis using step step1 φ
  using eqButPID_stateSelectors[OF ss1]
  unfolding φ_def2(* [OF step] φ_def2[OF step1]  *)
  by (auto simp: u_defs com_defs)
qed

lemma eqButPID_step_φ:
assumes s's1': "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
shows "φ (Trans s a ou s') = φ (Trans s1 a ou1 s1')"
by (metis eqButPID_step_φ_imp eqButPID_sym assms)


end

end
y>

Theory Post_ISSUER

theory Post_ISSUER
  imports
    "Bounded_Deducibility_Security.Compositional_Reasoning"
    "Post_Observation_Setup_ISSUER"
    "Post_Value_Setup_ISSUER"
begin

subsubsection ‹Issuer declassification bound›

text ‹We verify that a group of users of some node ‹i›,
allowed to take normal actions to the system and observe their outputs
\emph{and additionally allowed to observe communication},
can learn nothing about the updates to a post located at node ‹i›
and the sends of that post to other nodes beyond

(1) the presence of the sends (i.e., the number of the sending actions)

(2) the public knowledge that what is being sent is always the last version (modeled as
the correlation predicate)

unless:
\begin{itemize}
\item either a user in the group is the post's owner or the administrator
\item or a user in the group becomes a friend of the owner
\item or the group has at least one registered user and the post is being marked as "public"
\end{itemize}

See \cite{cosmedis-SandP2017} for more details.
›

context Post_ISSUER
begin

fun T :: "(state,act,out) trans ⇒ bool" where
"T (Trans s a ou s') ⟷
 (∃ uid ∈ UIDs.
   uid ∈∈ userIDs s' ∧ PID ∈∈ postIDs s' ∧
   (uid = admin s' ∨
    uid = owner s' PID ∨
    uid ∈∈ friendIDs s' (owner s' PID) ∨
    vis s' PID = PublicV))"

(* Correlation is defined to mean: always send what was last uploaded, or emptyPost
if nothing had been uploaded. This needs the auxiliary notion of "correlated from" *)
fun corrFrom :: "post ⇒ value list ⇒ bool" where
 "corrFrom pst [] = True"
|"corrFrom pst (PVal pstt # vl) = corrFrom pstt vl"
|"corrFrom pst (PValS aid pstt # vl) = (pst = pstt ∧ corrFrom pst vl)"

abbreviation corr :: "value list ⇒ bool" where "corr ≡ corrFrom emptyPost"

(* Beyond correlation (which is public knowledge), one can only learn
the absence of any secret produced (if that is the case), the number of
times the notice has been sent, and to which nodes they have been sent:
(since network traffic is assumed to be observable) *)
definition B :: "value list ⇒ value list ⇒ bool" where
"B vl vl1 ≡
 corr vl1 ∧
 (vl = [] ⟶ vl1 = []) ∧
 map PValS_tgtAPI (filter isPValS vl) = map PValS_tgtAPI (filter isPValS vl1)"


sublocale BD_Security_IO where
istate = istate and step = step and
φ = φ and f = f and γ = γ and g = g and T = T and B = B
done

subsubsection ‹Unwinding proof›

lemma reach_PublicV_imples_FriendV[simp]:
assumes "reach s"
and "vis s pID ≠ PublicV"
shows "vis s pID = FriendV"
using assms reach_vis by auto

lemma reachNT_state:
assumes "reachNT s"
shows "¬ (∃ uid ∈ UIDs.
   uid ∈∈ userIDs s ∧ PID ∈∈ postIDs s ∧
   (uid = admin s ∨ uid = owner s PID ∨ uid ∈∈ friendIDs s (owner s PID) ∨
    vis s PID = PublicV))"
using assms proof induct
  case (Step trn) thus ?case
  by (cases trn) auto
qed (simp add: istate_def)

(* major *) lemma T_φ_γ:
assumes 1: "reachNT s" and 2: "step s a = (ou,s')"
and 3: "φ (Trans s a ou s')" and
(* note that now we have some overlap between φ and γ, even for reachNT: *)
4: "∀ ca. a ≠ COMact ca"
shows "¬ γ (Trans s a ou s')"
using reachNT_state[OF 1] 2 3 4 using φ_def2(* [OF 2] *)
by (auto simp add: u_defs com_defs)

(* major *) lemma eqButPID_step_γ_out:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sT: "reachNT s" and T: "¬ T (Trans s a ou s')"
and s1: "reach s1"
and γ: "γ (Trans s a ou s')"
shows "(∃ uid p aid pid. a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨ ou = ou1"
proof-
  have s'T: "reachNT s'" using step sT T using reachNT_PairI by blast
  note op = reachNT_state[OF s'T]
  note [simp] = all_defs
  note s = reachNT_reach[OF sT]
  note willUse =
    step step1 γ
    op
    reach_vis[OF s]
    eqButPID_stateSelectors[OF ss1] (* eqButPID_postSelectors[OF ss1] *)
    eqButPID_actions[OF ss1]
    eqButPID_update[OF ss1] (* eqButPID_setTextPost[OF ss1] *) eqButPID_not_PID[OF ss1]
    (* added to cope with extra leak towards the admin, when moving from API to CAPI: *)
    (* eqButPID_eqButT[OF ss1] *) eqButPID_eqButF[OF ss1]
    eqButPID_setShared[OF ss1] eqButPID_updateShared[OF ss1]
    eeqButPID_F_not_PID eqButPID_not_PID_sharedWith
    eqButPID_insert2[OF ss1]
  show ?thesis
  proof (cases a)
    case (Sact x1)
    with willUse show ?thesis by (cases x1) auto
  next
    case (Cact x2)
    with willUse show ?thesis by (cases x2) auto
  next
    case (Dact x3)
    with willUse show ?thesis by (cases x3) auto
  next
    case (Uact x4)
    with willUse show ?thesis by (cases x4) auto
  next
    case (Ract x5)
    with willUse show ?thesis
    proof (cases x5)
      case (rPost uid p pid)
      with Ract willUse show ?thesis by (cases "pid = PID") auto
    qed auto
  next
    case (Lact x6)
    with willUse show ?thesis
    proof (cases x6)
      case (lClientsPost uid p pid)
      with Lact willUse show ?thesis by (cases "pid = PID") auto
    qed auto
  next
    case (COMact x7)
    with willUse show ?thesis by (cases x7) auto
  qed
qed

(* major *) lemma eqButPID_step_eq:
assumes ss1: "eqButPID s s1"
and a: "a = Uact (uPost uid p PID pst)" "ou = outOK"
and step: "step s a = (ou, s')" and step1: "step s1 a = (ou', s1')"
shows "s' = s1'"
using ss1 step step1
using eqButPID_stateSelectors[OF ss1]
eqButPID_update[OF ss1] (* eqButPID_setTextPost[OF ss1] *) eqButPID_setShared[OF ss1]
unfolding a by (auto simp: u_defs)

definition Δ0 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ0 s vl s1 vl1 ≡
 ¬ PID ∈∈ postIDs s ∧ post s PID = emptyPost ∧
 s = s1 ∧
 corrFrom (post s1 PID) vl1 ∧
 (vl = [] ⟶ vl1 = []) ∧
 map PValS_tgtAPI (filter isPValS vl) = map PValS_tgtAPI (filter isPValS vl1)"

definition Δ1 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ1 s vl s1 vl1 ≡
 PID ∈∈ postIDs s ∧
 eqButPID s s1 ∧
 corrFrom (post s1 PID) vl1 ∧
 (vl = [] ⟶ vl1 = []) ∧
 map PValS_tgtAPI (filter isPValS vl) = map PValS_tgtAPI (filter isPValS vl1)"

definition Δ2 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ2 s vl s1 vl1 ≡
 PID ∈∈ postIDs s ∧
 eqButPID s s1 ∧
 vl = [] ∧ list_all isPVal vl1"

lemma istate_Δ0:
assumes B: "B vl vl1"
shows "Δ0 istate vl istate vl1"
using assms unfolding Δ0_def B_def istate_def by auto

lemma unwind_cont_Δ0: "unwind_cont Δ0 {Δ0,Δ1}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ0 s vl s1 vl1 ∨ Δ1 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ0 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s" and pPID: "post s PID = emptyPost"
  and ch: "corrFrom (post s1 PID) vl1"
  and l: "map PValS_tgtAPI (filter isPValS vl) = map PValS_tgtAPI (filter isPValS vl1)"
  and PID: "¬ PID ∈∈ postIDs s" and vlvl1: "vl = [] ⟹ vl1 = []"
  using reachNT_reach unfolding Δ0_def by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof-
        have φ: "¬ φ ?trn" using PID step unfolding φ_def2(* [OF step] *) by (auto simp: u_defs com_defs)
        hence vl': "vl' = vl" using c φ unfolding consume_def by simp
        have pPID': "post s' PID = emptyPost"
          using pPID PID step
          apply(cases a)
          subgoal for x1 apply(cases x1, auto simp: all_defs) .
          subgoal for x2 apply(cases x2, auto simp: all_defs) .
          subgoal for x3 apply(cases x3, auto simp: all_defs) .
          subgoal for x4 apply(cases x4, auto simp: all_defs) .
          subgoal by auto
          subgoal by auto
          subgoal for x7 apply(cases x7, auto simp: all_defs) .
          done
        have ?match proof(cases "∃ uid p. a = Cact (cPost uid p PID) ∧ ou = outOK")
          case True
          then obtain uid p where a: "a = Cact (cPost uid p PID)" and ou: "ou = outOK" by auto
          have PID': "PID ∈∈ postIDs s'"
          using step PID unfolding a ou by (auto simp: c_defs)
          note uid = reachNT_state[OF rsT]
          show ?thesis proof
            show "validTrans ?trn1" unfolding ss1 using step by simp
          next
            show "consume ?trn1 vl1 vl1" using φ unfolding consume_def ss1 by auto
          next
            show "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            have "Δ1 s' vl' s' vl1" using l PID' c ch vlvl1 pPID' pPID
             unfolding ss1 Δ1_def vl' by auto
            thus "?Δ s' vl' s' vl1" by simp
          qed
        next
          case False note a = False
          have PID': "¬ PID ∈∈ postIDs s'"
            using step PID a
            apply(cases a)
            subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
            subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
            subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
            subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
            subgoal by auto
            subgoal by auto
            subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
            done
          show ?thesis proof
            show "validTrans ?trn1" unfolding ss1 using step by simp
          next
            show "consume ?trn1 vl1 vl1" using φ unfolding consume_def ss1 by auto
          next
            show "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            have "Δ0 s' vl' s' vl1" using a PID' pPID pPID' ch vlvl1 l unfolding Δ0_def vl' ss1 by simp
            thus "?Δ s' vl' s' vl1" by simp
          qed
        qed
        thus ?thesis by simp
      qed
    qed
  thus ?thesis using vlvl1 by simp
  qed
qed

lemma unwind_cont_Δ1: "unwind_cont Δ1 {Δ1,Δ2}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ1 s vl s1 vl1 ∨ Δ2 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ1 s vl s1 vl1"
  hence vlvl1: "vl = [] ⟶ vl1 = []" and ch1: "corrFrom (post s1 PID) vl1"
  and rs: "reach s" and ss1: "eqButPID s s1" and PID: "PID ∈∈ postIDs s"
  and l: "map PValS_tgtAPI (filter isPValS vl) = map PValS_tgtAPI (filter isPValS vl1)"
  using reachNT_reach unfolding Δ1_def by auto
  have PID1: "PID ∈∈ postIDs s1" using eqButPID_stateSelectors[OF ss1] PID by auto
  have own: "owner s PID ∈ set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  hence own1: "owner s1 PID ∈ set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof(cases vl1)
    case (Cons v1 vll1) note vl1 = Cons
    obtain v vll where vl: "vl = v # vll" using vl1 vlvl1 by (cases vl) auto
    show ?thesis
    proof(cases v1)
      case (PVal pst1) note v1 = PVal
      let ?uid1 = "owner s1 PID" let ?p1 = "pass s1 ?uid1"
      have uid1: "?uid1 ∈∈ userIDs s1" using reach_owner_userIDs[OF rs1 PID1] .
      define a1 where "a1 ≡ Uact (uPost ?uid1 ?p1 PID pst1)"
      obtain s1' ou1 where step1: "step s1 a1 = (ou1,s1')" by force
      hence ou1: "ou1 = outOK" using PID1 uid1 unfolding a1_def by (auto simp: u_defs)
      let ?trn1 = "Trans s1 a1 ou1 s1'"
      have φ1: "φ ?trn1" unfolding a1_def PID1 ou1 by simp
      have 2[simp]: "post s1' PID = pst1"
      using step1 unfolding a1_def ou1 by (auto simp: u_defs)
      have "?uid1 = owner s PID" using eqButPID_stateSelectors[OF ss1] by simp
      hence uid1: "?uid1 ∉ UIDs" using reachNT_state own rsT PID by auto
      have "eqButPID s1 s1'" using step1 a1_def Uact_uPaperC_step_eqButPID by auto
      hence ss1': "eqButPID s s1'" using ss1 using eqButPID_trans by blast
      have "?iact" proof
        show "step s1 a1 = (ou1, s1')" "φ ?trn1" by fact+
        show "consume (Trans s1 a1 ou1 s1') vl1 vll1"
        using φ1 unfolding consume_def vl1 a1_def v1 by simp
        show "¬ γ ?trn1" using uid1 unfolding a1_def by auto
        show "?Δ s vl s1' vll1"
        proof(cases vll1)
          case Nil
          have "Δ1 s vl s1' vll1" using PID ss1' l unfolding Δ1_def B_def vl1 v1 Nil by auto
          thus ?thesis by simp
        next
          case (Cons w1 vlll1) note vll1 = Cons
          have "Δ1 s vl s1' vll1" using PID ss1' l ch1
          unfolding Δ1_def B_def vl1 v1 vl by auto
          thus ?thesis by simp
        qed
      qed
      thus ?thesis by simp
    next
      case (PValS aid1 pst1) note v1 = PValS
      have pst1: "pst1 = post s1 PID" using ch1 unfolding vl1 v1 by simp
      show ?thesis
      proof(cases v)
        case (PVal "pst") note v = PVal
        hence vll: "vll ≠ []" using vlvl1 l unfolding vl vl1 v v1 by auto
        have ?react proof
          fix a :: act and ou :: out and s' :: state and vl'
          let ?trn = "Trans s a ou s'"
          assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
          have vl': "vl' = vl ∨ vl' = vll" using c unfolding vl consume_def by (cases "φ ?trn") auto
          hence vl'NE: "vl' ≠ []" using vll vl by auto
          have fvl': "filter isPValS vl' = filter isPValS vll" using vl' unfolding vl v by auto
          obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by fastforce
          let ?trn1 = "Trans s1 a ou1 s1'"
          have s's1': "eqButPID s' s1'" using eqButPID_step ss1 step step1 by blast
          have γγ1: "γ ?trn ⟷ γ ?trn1" by simp
          have PID': "PID ∈∈ postIDs s'" using step rs PID using reach_postIDs_persist by blast
          have 2[simp]: "¬ φ ?trn1 ⟹ post s1' PID = post s1 PID"
            using step1 PID1 unfolding φ_def2(* [OF step1] *)
            apply(cases a, auto)
            subgoal for x1 apply(cases x1, auto simp: all_defs) .
            subgoal for x2 apply(cases x2, auto simp: all_defs) .
            subgoal for x3 apply(cases x3, auto simp: all_defs) .
            subgoal for x4 apply(cases x4, auto simp: all_defs) .
            subgoal for x4 apply(cases x4, auto simp: all_defs) .
            subgoal for x7 apply(cases x7, auto simp: all_defs) .
            subgoal for x7 apply(cases x7, auto simp: all_defs) .
            done
          show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
          proof(cases "γ ?trn")
            case True note γ = True
            have ou: "(∃ uid p aid pid. a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                                        ou = ou1"
            using eqButPID_step_γ_out[OF ss1 step step1 rsT T rs1 γ] .
            {assume φ: "φ ?trn"
             hence "f ?trn = v" using c unfolding consume_def vl by simp
             hence "∀ca. a ≠ COMact ca" using φ unfolding φ_def3[OF step] v by auto
             hence False using T_φ_γ[OF rsT step φ] γ by auto
            }
            hence φ: "¬ φ ?trn" by auto
            have vl': "vl' = vl" using φ c unfolding consume_def by simp
            have φ1: "¬ φ ?trn1" using step step1 ss1 φ eqButPID_step_φ by blast
            have ?match proof
              show "validTrans ?trn1" using step1 by auto
              show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def by simp
              show "γ ?trn ⟷ γ ?trn1" by fact
            next
              show "g ?trn = g ?trn1" using ou by (cases a) auto
              have "Δ1 s' vl' s1' vl1"
              using PID' s's1' vlvl1 l ch1 φ1 unfolding Δ1_def vl' by auto
              thus "?Δ s' vl' s1' vl1" by simp
            qed
            thus ?thesis by simp
          next
            case False note γ = False
            show ?thesis
            proof(cases "φ ?trn")
              case True note φ = True
              hence "f ?trn = v" using c unfolding consume_def vl by simp
              hence "∀ca. a ≠ COMact ca" using φ unfolding φ_def3[OF step] v by auto
              then obtain uid p "pstt" where a: "a = Uact (uPost uid p PID pstt)"
              using φ unfolding φ_def2(* [OF step] *) by auto
              hence ss': "eqButPID s s'" using step Uact_uPaperC_step_eqButPID by auto
              hence s's1: "eqButPID s' s1" using ss1 eqButPID_sym eqButPID_trans by blast
              have ?ignore proof
                show "¬ γ ?trn" by fact
                have "Δ1 s' vl' s1 vl1"
                using PID' s's1' ch1 l vl'NE s's1 unfolding Δ1_def fvl' vl v by auto
                thus "?Δ s' vl' s1 vl1" by simp
              qed
              thus ?thesis by simp
            next
              case False note φ = False
              have vl': "vl' = vl" using φ c unfolding consume_def by simp
              have φ1: "¬ φ ?trn1" using step step1 ss1 φ eqButPID_step_φ by blast
              have ?match proof
                show "validTrans ?trn1" using step1 by auto
                show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def by simp
                show "γ ?trn ⟷ γ ?trn1" by fact
              next
                assume "γ ?trn" thus "g ?trn = g ?trn1" using γ by simp
              next
                have "Δ1 s' vl' s1' vl1"
                using PID' s's1' vlvl1 l ch1 φ1 unfolding Δ1_def vl' by auto
                thus "?Δ s' vl' s1' vl1" by simp
              qed
              thus ?thesis by simp
            qed
          qed
        qed
        thus ?thesis using vlvl1 by simp
      next
        case (PValS aid "pst") note v = PValS
        have ?react proof
          fix a :: act and ou :: out and s' :: state and vl'
          let ?trn = "Trans s a ou s'"
          assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
          have vl': "vl' = vl ∨ vl' = vll" using c unfolding vl consume_def by (cases "φ ?trn") auto
          obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by fastforce
          let ?trn1 = "Trans s1 a ou1 s1'"
          have s's1': "eqButPID s' s1'" using eqButPID_step ss1 step step1 by blast
          have γγ1: "γ ?trn ⟷ γ ?trn1" by simp
          have PID': "PID ∈∈ postIDs s'" using step rs PID using reach_postIDs_persist by blast
          show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
          proof-
            have ?match proof(cases "φ ?trn")
              case True note φ = True
              have φ1: "φ ?trn1" using step step1 ss1 φ eqButPID_step_φ by blast
              let ?ad = "admin s"  let ?p = "pass s ?ad" let ?pst = "post s PID"
              let ?uid = "owner s PID" let ?vs = "vis s PID"
              obtain vl': "vl' = vll"
              and ou: "ou = O_sendPost (aid, clientPass s aid, PID, pst, ?uid, ?vs)"
              and a: "a = COMact (comSendPost ?ad ?p aid PID)" and "pst": "pst = ?pst"
              using φ c unfolding φ_def3[OF step] consume_def vl v by auto
              let ?pst1 = "post s1 PID"
              have "clientPass s aid = clientPass s1 aid" and "?uid = owner s1 PID"
              and "?vs = vis s1 PID"
              using eqButPID_stateSelectors[OF ss1] by auto
              hence ou1: "ou1 = O_sendPost (aid, clientPass s aid, PID, ?pst1, ?uid, ?vs)"
              using step1 φ1 unfolding φ_def3[OF step1] vl1 v1 a
              by (auto simp: com_defs)
              have 2[simp]: "post s1' PID = pst1"
              using step1 unfolding a ou1 pst1 by (auto simp: com_defs)
              have ch_vll1: "corrFrom pst1 vll1" using ch1 unfolding pst1[symmetric] vl1 v1 by auto
              show ?thesis proof
                show "validTrans ?trn1" using step1 by auto
                show "consume (Trans s1 a ou1 s1') vl1 vll1"
                using l φ1 pst1 unfolding consume_def vl vl1 v v1 a ou1 by simp
                show "γ ?trn ⟷ γ ?trn1" by fact
              next
                show "g ?trn = g ?trn1" unfolding a ou ou1 by (simp add: ss1)
                show "?Δ s' vl' s1' vll1"
                proof(cases "vll = []")
                  case False
                  hence "Δ1 s' vl' s1' vll1" using PID' s's1' vlvl1 l ch1 ch_vll1
                  unfolding Δ1_def vl' vl vl1 v v1 by auto
                  thus ?thesis by simp
                next
                  case True
                  hence "list_all isPVal vll1" using l unfolding vl vl1 v v1 by (simp add: filter_isPValS_Nil)
                  hence "Δ2 s' vl' s1' vll1" using True PID' s's1' vlvl1 l ch1 ch_vll1
                  unfolding Δ2_def vl' vl vl1 v v1 by simp
                  thus ?thesis by simp
                qed
              qed
            next
              case False note φ = False
              have vl': "vl' = vl" using φ c unfolding consume_def by simp
              have φ1: "¬ φ ?trn1" using step step1 ss1 φ eqButPID_step_φ by blast
              have ?match proof
                show "validTrans ?trn1" using step1 by auto
                show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def by simp
                show "γ ?trn ⟷ γ ?trn1" by fact
              next
                assume "γ ?trn" note γ = this
                have ou: "(∃ uid p aid pid. a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                                        ou = ou1"
                using eqButPID_step_γ_out[OF ss1 step step1 rsT T rs1 γ] .
                thus "g ?trn = g ?trn1" by (cases a) auto
              next
                have 2[simp]: "post s1' PID  = post s1 PID"
                  using step1 PID1 φ1 unfolding φ_def2(* [OF step1] *)
                  apply(cases a)
                  subgoal for x1 apply(cases x1, auto simp: all_defs) .
                  subgoal for x2 apply(cases x2, auto simp: all_defs) .
                  subgoal for x3 apply(cases x3, auto simp: all_defs) .
                  subgoal for x4 apply(cases x4, auto simp: all_defs) .
                  subgoal by auto
                  subgoal by auto
                  subgoal for x7 apply(cases x7, auto simp: all_defs) .
                  done
                have "Δ1 s' vl' s1' vl1" using PID' s's1' vlvl1 l ch1
                unfolding Δ1_def vl' vl vl1 v v1 by auto
                thus "?Δ s' vl' s1' vl1" by simp
              qed
              thus ?thesis by simp
            qed
            thus ?thesis by simp
          qed
        qed
        thus ?thesis using vlvl1 by simp
      qed
    qed
  next
    case Nil note vl1 = Nil
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by fastforce
      let ?trn1 = "Trans s1 a ou1 s1'"
      have s's1': "eqButPID s' s1'" using eqButPID_step ss1 step step1 by blast
      have γγ1: "γ ?trn ⟷ γ ?trn1" by simp
      have PID': "PID ∈∈ postIDs s'" using step rs PID using reach_postIDs_persist by blast
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof(cases "φ ?trn")
        case True note φ = True
        then obtain v vll where vl: "vl = v # vll"
        and f: "f ?trn = v" using c unfolding consume_def by (cases vl) auto
        obtain "pst" where v: "v = PVal pst" using l unfolding vl1 vl by (cases v) auto
        have fvll: "filter isPValS vll = []"using l unfolding vl1 vl by auto
        have vl': "vl' = vll" using c φ unfolding vl consume_def by auto
        hence 0: "∀ca. a ≠ COMact ca" using φ v f unfolding φ_def3[OF step] by auto
        then obtain uid p "pstt" where a: "a = Uact (uPost uid p PID pstt)"
        using φ unfolding φ_def2(* [OF step] *) by auto
        hence ss': "eqButPID s s'" using step Uact_uPaperC_step_eqButPID by auto
        hence s's1: "eqButPID s' s1" using ss1 eqButPID_sym eqButPID_trans by blast
        have ?ignore proof
          show "¬ γ ?trn" using T_φ_γ[OF rsT step φ 0] .
          have "Δ1 s' vl' s1 vl1"
          using PID' s's1' ch1 l s's1 vl1 fvll  unfolding Δ1_def vl v vl' by auto
          thus "?Δ s' vl' s1 vl1" by simp
        qed
        thus ?thesis by simp
      next
        case False note φ = False
        have vl': "vl' = vl" using φ c unfolding consume_def by simp
        have φ1: "¬ φ ?trn1" using step step1 ss1 φ eqButPID_step_φ by blast
        have ?match proof
          show "validTrans ?trn1" using step1 by auto
          show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def by simp
          show "γ ?trn ⟷ γ ?trn1" by fact
        next
          assume "γ ?trn" note γ = this
          have ou: "(∃ uid p aid pid. a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                                        ou = ou1"
          using eqButPID_step_γ_out[OF ss1 step step1 rsT T rs1 γ] .
          thus "g ?trn = g ?trn1" by (cases a) auto
        next
          have 2[simp]: "post s1' PID  = post s1 PID"
            using step1 PID1 φ1 unfolding φ_def2(* [OF step1] *)
            apply(cases a)
            subgoal for x1 apply(cases x1, auto simp: all_defs) .
            subgoal for x2 apply(cases x2, auto simp: all_defs) .
            subgoal for x3 apply(cases x3, auto simp: all_defs) .
            subgoal for x4 apply(cases x4, auto simp: all_defs) .
            subgoal by auto
            subgoal by auto
            subgoal for x7 apply(cases x7, auto simp: all_defs) .
            done
          have "Δ1 s' vl' s1' vl1" using PID' s's1' vlvl1 l ch1
          unfolding Δ1_def vl' vl1 by auto
          thus "?Δ s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl1 by simp
  qed
qed

lemma unwind_cont_Δ2: "unwind_cont Δ2 {Δ2}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ2 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ2 s vl s1 vl1"
  hence PID: "PID ∈∈ postIDs s" and ss1: "eqButPID s s1" and vl: "vl = []" and lvl1: "list_all isPVal vl1"
  and rs: "reach s" using reachNT_reach unfolding Δ2_def by auto
  have PID1: "PID ∈∈ postIDs s1" using eqButPID_stateSelectors[OF ss1] PID by auto
  have own: "owner s PID ∈ set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  hence own1: "owner s1 PID ∈ set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof(cases vl1)
    case (Cons v1 vll1) note vl1 = Cons
    obtain pst1 where v1: "v1 = PVal pst1" and lvll1: "list_all isPVal vll1"
      using lvl1 unfolding vl1 by (cases v1) auto
    define uid where "uid ≡ owner s PID"  define p where "p ≡ pass s uid"
    define a1 where "a1 ≡ Uact (uPost uid p PID pst1)"
    have uid1: "uid = owner s1 PID" and p1: "p = pass s1 uid" unfolding uid_def p_def
    using eqButPID_stateSelectors[OF ss1] by auto
    obtain ou1 s1' where step1: "step s1 a1 = (ou1, s1')" by(cases "step s1 a1") auto
    have ou1: "ou1 = outOK" using step1 PID1 own1 unfolding a1_def uid1 p1 by (auto simp: u_defs)
    have uid: "uid ∉ UIDs" unfolding uid_def using rsT reachNT_state own PID by blast
    let ?trn1 = "Trans s1 a1 ou1 s1'"
    have ?iact proof
      show "step s1 a1 = (ou1, s1')" using step1 .
    next
      show φ1: "φ ?trn1" unfolding φ_def2(* [OF step1] *) a1_def ou1 by simp
      show "consume ?trn1 vl1 vll1"
      using φ1 unfolding vl1 consume_def a1_def v1 by simp
      show "¬ γ ?trn1" using uid unfolding a1_def by simp
    next
      have "eqButPID s1 s1'" using Uact_uPaperC_step_eqButPID[OF _ step1] a1_def by auto
      hence ss1': "eqButPID s s1'" using eqButPID_trans ss1 by blast
      show "Δ2 s vl s1' vll1"
      using PID ss1' lvll1 unfolding Δ2_def vl by auto
    qed
    thus ?thesis by simp
  next
    case Nil note vl1 = Nil
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by fastforce
      let ?trn1 = "Trans s1 a ou1 s1'"
      have s's1': "eqButPID s' s1'" using eqButPID_step ss1 step step1 by blast
      have γγ1: "γ ?trn ⟷ γ ?trn1" by simp
      have PID': "PID ∈∈ postIDs s'" using step rs PID using reach_postIDs_persist by blast
      have φ: "¬ φ ?trn" and vl': "vl' = vl" using c unfolding vl consume_def by auto
      hence φ1: "¬ φ ?trn1" using eqButPID_step_φ step ss1 step1 by auto
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof-
        have ?match proof
          show "validTrans ?trn1" using step1 by auto
          show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def by simp
          show "γ ?trn ⟷ γ ?trn1" by fact
        next
          assume "γ ?trn" note γ = this
          have ou: "(∃ uid p aid pid. a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                                        ou = ou1"
          using eqButPID_step_γ_out[OF ss1 step step1 rsT T rs1 γ] .
          thus "g ?trn = g ?trn1" by (cases a) auto
        next
          have 2[simp]: "textPost (post s1' PID)  = textPost (post s1 PID)"
            using step1 PID1 φ1 unfolding φ_def2(* [OF step1] *)
            apply(cases a)
            subgoal for x1 apply(cases x1, auto simp: all_defs) .
            subgoal for x2 apply(cases x2, auto simp: all_defs) .
            subgoal for x3 apply(cases x3, auto simp: all_defs) .
            subgoal for x4 apply(cases x4, auto simp: all_defs) .
            subgoal by auto
            subgoal by auto
            subgoal for x7 apply(cases x7, auto simp: all_defs) .
            done
          show "Δ2 s' vl' s1' vl1" using PID' s's1' vl
          unfolding Δ2_def vl1 vl' by auto
        qed
        thus ?thesis by simp
      qed
    qed
  thus ?thesis using vl1 by simp
  qed
qed

definition Gr where
"Gr =
 {
 (Δ0, {Δ0,Δ1}),
 (Δ1, {Δ1,Δ2}),
 (Δ2, {Δ2})
 }"


theorem Post_secure: secure
apply (rule unwind_decomp_secure_graph[of Gr Δ0])
unfolding Gr_def
apply (simp, smt insert_subset order_refl)
using istate_Δ0 unwind_cont_Δ0 unwind_cont_Δ1 unwind_cont_Δ2
unfolding Gr_def by auto



end (* context Post_ISSUER *)

end
itle>

Theory Post_Observation_Setup_RECEIVER

theory Post_Observation_Setup_RECEIVER
  imports "../Safety_Properties"
begin

subsection ‹Confidentiality for a secret receiver node›

text ‹We verify that a group of users of a given node ‹j›
can learn nothing about the updates to the content of a post
‹PID› located at a different node ‹i› beyond the
existence of an update unless ‹PID› is being shared between
the two nodes and one of the users is the admin at node ‹j› or becomes
a remote friend of ‹PID›'s owner, or ‹PID› is marked as public.
This is formulated as a BD Security
property and is proved by unwinding.

See \cite{cosmedis-SandP2017} for more details.
›

subsubsection‹Observation setup›

(* *)
type_synonym obs = "act * out"

(* The observers are an arbitrary, but fixed set of users *)
locale Fixed_UIDs = fixes UIDs :: "userID set"
(* The secret is PID received from AID:  *)
locale Fixed_PID = fixes PID :: "postID"
locale Fixed_AID = fixes AID :: "apiID"

locale ObservationSetup_RECEIVER = Fixed_UIDs + Fixed_PID + Fixed_AID
begin

(*  *)
fun γ :: "(state,act,out) trans ⇒ bool" where
"γ (Trans _ a _ _) ⟷
   (∃ uid. userOfA a = Some uid ∧ uid ∈ UIDs)
   ∨
   (∃ca. a = COMact ca)
   ∨
   (∃uid p. a = Sact (sSys uid p))"

(* Note: the passwords don't really have to be purged (since identity theft is not
considered in the first place); however, purging passwords looks more sane. *)

(* Purging the password in starting actions: *)
fun sPurge :: "sActt ⇒ sActt" where
"sPurge (sSys uid pwd) = sSys uid emptyPass"

(* Purging communicating actions: user-password information is removed, and post content for PID
  is removed from the only kind of action that may contain such info: comReceivePost.
  Note: server-password info is not purged --todo: discuss this.  *)
fun comPurge :: "comActt ⇒ comActt" where
 "comPurge (comSendServerReq uID p aID reqInfo) = comSendServerReq uID emptyPass aID reqInfo"
|"comPurge (comConnectClient uID p aID sp) = comConnectClient uID emptyPass aID sp"
(* *)
|"comPurge (comReceivePost aID sp pID pst uID vs) =
  (let pst' = (if aID = AID ∧ pID = PID then emptyPost else pst)
   in comReceivePost aID sp pID pst' uID vs)"
(* *)
|"comPurge (comSendPost uID p aID pID) = comSendPost uID emptyPass aID pID"
|"comPurge (comSendCreateOFriend uID p aID uID') = comSendCreateOFriend uID emptyPass aID uID'"
|"comPurge (comSendDeleteOFriend uID p aID uID') = comSendDeleteOFriend uID emptyPass aID uID'"
|"comPurge ca = ca"

(* Note: No output purge here -- only for the issuer. *)

fun g :: "(state,act,out)trans ⇒ obs" where
 "g (Trans _ (Sact sa) ou _) = (Sact (sPurge sa), ou)"
|"g (Trans _ (COMact ca) ou _) = (COMact (comPurge ca), ou)"
|"g (Trans _ a ou _) = (a,ou)"

lemma comPurge_simps:
  "comPurge ca = comSendServerReq uID p aID reqInfo ⟷ (∃p'. ca = comSendServerReq uID p' aID reqInfo ∧ p = emptyPass)"
  "comPurge ca = comReceiveClientReq aID reqInfo ⟷ ca = comReceiveClientReq aID reqInfo"
  "comPurge ca = comConnectClient uID p aID sp ⟷ (∃p'. ca = comConnectClient uID p' aID sp ∧ p = emptyPass)"
  "comPurge ca = comConnectServer aID sp ⟷ ca = comConnectServer aID sp"
  "comPurge ca = comReceivePost aID sp pID pst' uID v ⟷ (∃pst. ca = comReceivePost aID sp pID pst uID v ∧ pst' = (if pID = PID ∧ aID = AID then emptyPost else pst))"
  "comPurge ca = comSendPost uID p aID pID ⟷ (∃p'. ca = comSendPost uID p' aID pID ∧ p = emptyPass)"
  "comPurge ca = comSendCreateOFriend uID p aID uID' ⟷ (∃p'. ca = comSendCreateOFriend uID p' aID uID' ∧ p = emptyPass)"
  "comPurge ca = comReceiveCreateOFriend aID cp uID uID' ⟷ ca = comReceiveCreateOFriend aID cp uID uID'"
  "comPurge ca = comSendDeleteOFriend uID p aID uID' ⟷ (∃p'. ca = comSendDeleteOFriend uID p' aID uID' ∧ p = emptyPass)"
  "comPurge ca = comReceiveDeleteOFriend aID cp uID uID' ⟷ ca = comReceiveDeleteOFriend aID cp uID uID'"
by (cases ca; auto)+

lemma g_simps:
  "g (Trans s a ou s') = (COMact (comSendServerReq uID p aID reqInfo), ou')
⟷ (∃p'. a = COMact (comSendServerReq uID p' aID reqInfo) ∧ p = emptyPass ∧ ou = ou')"
  "g (Trans s a ou s') = (COMact (comReceiveClientReq aID reqInfo), ou')
⟷ a = COMact (comReceiveClientReq aID reqInfo) ∧ ou = ou'"
  "g (Trans s a ou s') = (COMact (comConnectClient uID p aID sp), ou')
⟷ (∃p'. a = COMact (comConnectClient uID p' aID sp) ∧ p = emptyPass ∧ ou = ou')"
  "g (Trans s a ou s') = (COMact (comConnectServer aID sp), ou')
⟷ a = COMact (comConnectServer aID sp) ∧ ou = ou'"
  "g (Trans s a ou s') = (COMact (comReceivePost aID sp pID pst' uID v), ou')
⟷ (∃pst. a = COMact (comReceivePost aID sp pID pst uID v) ∧ pst' = (if pID = PID ∧ aID = AID then emptyPost else pst) ∧ ou = ou')"
   "g (Trans s a ou s') = (COMact (comSendPost uID p aID nID), O_sendPost (aid, sp, pid, pst, own, v))
⟷ (∃p'. a = COMact (comSendPost uID p' aID nID) ∧ p = emptyPass ∧ ou = O_sendPost (aid, sp, pid, pst, own, v))"
  "g (Trans s a ou s') = (COMact (comSendCreateOFriend uID p aID uID'), ou')
⟷ (∃p'. a = (COMact (comSendCreateOFriend uID p' aID uID')) ∧ p = emptyPass ∧ ou = ou')"
  "g (Trans s a ou s') = (COMact (comReceiveCreateOFriend aID cp uID uID'), ou')
⟷ a = COMact (comReceiveCreateOFriend aID cp uID uID') ∧ ou = ou'"
  "g (Trans s a ou s') = (COMact (comSendDeleteOFriend uID p aID uID'), ou')
⟷ (∃p'. a = COMact (comSendDeleteOFriend uID p' aID uID') ∧ p = emptyPass ∧ ou = ou')"
  "g (Trans s a ou s') = (COMact (comReceiveDeleteOFriend aID cp uID uID'), ou')
⟷ a = COMact (comReceiveDeleteOFriend aID cp uID uID') ∧ ou = ou'"
by (cases a; auto simp: comPurge_simps ObservationSetup_RECEIVER.comPurge.simps)+

end

end
tle>

Theory Post_Unwinding_Helper_RECEIVER

theory Post_Unwinding_Helper_RECEIVER
  imports Post_Observation_Setup_RECEIVER
begin

subsubsection ‹Unwinding helper definitions and lemmas›

locale Receiver_State_Equivalence_Up_To_PID = Fixed_PID + Fixed_AID
begin

(* Auxiliary notion: two functions are equal everywhere but on the content of
   the value corresponding to PID *)
definition eeqButPID where
"eeqButPID psts psts1 ≡
 ∀ aid pid. if aid = AID ∧ pid = PID then True
                                     else psts aid pid = psts1 aid pid"

lemmas eeqButPID_intro = eeqButPID_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eeqButPID_eeq[simp,intro!]: "eeqButPID psts psts"
unfolding eeqButPID_def by auto

lemma eeqButPID_sym:
assumes "eeqButPID psts psts1" shows "eeqButPID psts1 psts"
using assms unfolding eeqButPID_def by auto

lemma eeqButPID_trans:
assumes "eeqButPID psts psts1" and "eeqButPID psts1 psts2" shows "eeqButPID psts psts2"
using assms unfolding eeqButPID_def by (auto split: if_splits)

lemma eeqButPID_cong:
assumes "eeqButPID psts psts1"
and "aid = AID ⟹ pid = PID ⟹ eqButT uu uu1"
and "aid ≠ AID ∨ pid ≠ PID ⟹ uu = uu1"
shows "eeqButPID (fun_upd2 psts aid pid uu) (fun_upd2 psts1 aid pid uu1)"
using assms unfolding eeqButPID_def fun_upd2_def by (auto split: if_splits)

(*
lemma eeqButPID_eqButT:
"eeqButPID psts psts1 ⟹ eqButT (psts AID PID) (psts1 AID PID)"
unfolding eeqButPID_def by (auto split: if_splits)
*)

lemma eeqButPID_not_PID:
"⟦eeqButPID psts psts1; aid ≠ AID ∨ pid ≠ PID⟧ ⟹ psts aid pid = psts1 aid pid"
unfolding eeqButPID_def by (auto split: if_splits)

lemma eeqButPID_toEq:
assumes "eeqButPID psts psts1"
shows "fun_upd2 psts AID PID pst =
       fun_upd2 psts1 AID PID pst"
using eeqButPID_not_PID[OF assms]
unfolding fun_upd2_def by (auto split: if_splits intro!: ext)

lemma eeqButPID_update_post:
assumes "eeqButPID psts psts1"
shows "eeqButPID (fun_upd2 psts aid pid pst) (fun_upd2 psts1 aid pid pst)"
using eeqButPID_not_PID[OF assms]
unfolding fun_upd2_def
using assms unfolding eeqButPID_def by auto


(* lists two pairs (apiID, boolean flag) are equal save for the boolean flag: *)
fun eqButF :: "(apiID × bool) list ⇒ (apiID × bool) list ⇒ bool" where
"eqButF aID_bl aID_bl1 = (map fst aID_bl = map fst aID_bl1)"

lemma eqButF_eq[simp,intro!]: "eqButF aID_bl aID_bl"
by auto

lemma eqButF_sym:
assumes "eqButF aID_bl aID_bl1"
shows "eqButF aID_bl1 aID_bl"
using assms by auto

lemma eqButF_trans:
assumes "eqButF aID_bl aID_bl1" and "eqButF aID_bl1 aID_bl2"
shows "eqButF aID_bl aID_bl2"
using assms by auto

lemma eqButF_insert2:
"eqButF aID_bl aID_bl1 ⟹
 eqButF (insert2 aID b aID_bl) (insert2 aID b aID_bl1)"
unfolding insert2_def
by simp (smt comp_apply fst_conv map_eq_conv split_def)


(* The notion of two states being equal everywhere but on the content of
   the post associated to a given PID and the update status of the PID shareWith info: *)
definition eqButPID :: "state ⇒ state ⇒ bool" where
"eqButPID s s1 ≡
 admin s = admin s1 ∧

 pendingUReqs s = pendingUReqs s1 ∧ userReq s = userReq s1 ∧
 userIDs s = userIDs s1 ∧ user s = user s1 ∧ pass s = pass s1 ∧

 pendingFReqs s = pendingFReqs s1 ∧ friendReq s = friendReq s1 ∧ friendIDs s = friendIDs s1 ∧
 sentOuterFriendIDs s = sentOuterFriendIDs s1 ∧ recvOuterFriendIDs s = recvOuterFriendIDs s1 ∧

 postIDs s = postIDs s1 ∧ admin s = admin s1 ∧
 post s = post s1 ∧
 owner s = owner s1 ∧
 vis s = vis s1 ∧

 pendingSApiReqs s = pendingSApiReqs s1 ∧ sApiReq s = sApiReq s1 ∧
 serverApiIDs s = serverApiIDs s1 ∧ serverPass s = serverPass s1 ∧
 outerPostIDs s = outerPostIDs s1 ∧
 eeqButPID (outerPost s) (outerPost s1) ∧
 outerOwner s = outerOwner s1 ∧
 outerVis s = outerVis s1 ∧

 pendingCApiReqs s = pendingCApiReqs s1 ∧ cApiReq s = cApiReq s1 ∧
 clientApiIDs s = clientApiIDs s1 ∧ clientPass s = clientPass s1 ∧
 sharedWith s = sharedWith s1"

lemmas eqButPID_intro = eqButPID_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eqButPID_refl[simp,intro!]: "eqButPID s s"
unfolding eqButPID_def by auto

lemma eqButPID_sym:
assumes "eqButPID s s1" shows "eqButPID s1 s"
using assms eeqButPID_sym unfolding eqButPID_def by auto

lemma eqButPID_trans:
assumes "eqButPID s s1" and "eqButPID s1 s2" shows "eqButPID s s2"
using assms eeqButPID_trans unfolding eqButPID_def
by simp blast

(* Implications from eqButPID, including w.r.t. auxiliary operations: *)
lemma eqButPID_stateSelectors:
"eqButPID s s1 ⟹
 admin s = admin s1 ∧

 pendingUReqs s = pendingUReqs s1 ∧ userReq s = userReq s1 ∧
 userIDs s = userIDs s1 ∧ user s = user s1 ∧ pass s = pass s1 ∧

 pendingFReqs s = pendingFReqs s1 ∧ friendReq s = friendReq s1 ∧ friendIDs s = friendIDs s1 ∧
 sentOuterFriendIDs s = sentOuterFriendIDs s1 ∧ recvOuterFriendIDs s = recvOuterFriendIDs s1 ∧

 postIDs s = postIDs s1 ∧ admin s = admin s1 ∧
 post s = post s1 ∧
 owner s = owner s1 ∧
 vis s = vis s1 ∧

 pendingSApiReqs s = pendingSApiReqs s1 ∧ sApiReq s = sApiReq s1 ∧
 serverApiIDs s = serverApiIDs s1 ∧ serverPass s = serverPass s1 ∧
 outerPostIDs s = outerPostIDs s1 ∧
 eeqButPID (outerPost s) (outerPost s1) ∧
 outerOwner s = outerOwner s1 ∧
 outerVis s = outerVis s1 ∧

 pendingCApiReqs s = pendingCApiReqs s1 ∧ cApiReq s = cApiReq s1 ∧
 clientApiIDs s = clientApiIDs s1 ∧ clientPass s = clientPass s1 ∧
 sharedWith s = sharedWith s1 ∧

 IDsOK s = IDsOK s1"
unfolding eqButPID_def IDsOK_def[abs_def] by auto

lemma eqButPID_not_PID:
"eqButPID s s1 ⟹ aid ≠ AID ∨ pid ≠ PID ⟹ outerPost s aid pid = outerPost s1 aid pid"
unfolding eqButPID_def using eeqButPID_not_PID by auto

lemma eqButPID_actions:
assumes "eqButPID s s1"
shows "listInnerPosts s uid p = listInnerPosts s1 uid p"
and "listOuterPosts s uid p = listOuterPosts s1 uid p"
using eqButPID_stateSelectors[OF assms] (* eqButPID_postSelectors[OF assms] *)
by (auto simp: l_defs intro!: arg_cong2[of _ _ _ _ cmap])

lemma eqButPID_update:
assumes "eqButPID s s1"
shows "fun_upd2 (outerPost s) AID PID pst = fun_upd2 (outerPost s1) AID PID pst"
using assms unfolding eqButPID_def using eeqButPID_toEq by (metis fun_upd2_absorb)

lemma eqButPID_update_post:
assumes "eqButPID s s1"
shows "eeqButPID (fun_upd2 (outerPost s) aid pid pst) (fun_upd2 (outerPost s1) aid pid pst)"
using assms unfolding eqButPID_def using eeqButPID_update_post by auto

lemma eqButPID_cong[simp, intro]:
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇admin := uu1⦈) (s1 ⦇admin := uu2⦈)"

"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇pendingUReqs := uu1⦈) (s1 ⦇pendingUReqs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇userReq := uu1⦈) (s1 ⦇userReq := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇userIDs := uu1⦈) (s1 ⦇userIDs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇user := uu1⦈) (s1 ⦇user := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇pass := uu1⦈) (s1 ⦇pass := uu2⦈)"

"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇postIDs := uu1⦈) (s1 ⦇postIDs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇post := uu1⦈) (s1 ⦇post := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇owner := uu1⦈) (s1 ⦇owner := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇vis := uu1⦈) (s1 ⦇vis := uu2⦈)"

"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇pendingFReqs := uu1⦈) (s1 ⦇pendingFReqs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇friendReq := uu1⦈) (s1 ⦇friendReq := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇friendIDs := uu1⦈) (s1 ⦇friendIDs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇sentOuterFriendIDs := uu1⦈) (s1 ⦇sentOuterFriendIDs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇recvOuterFriendIDs := uu1⦈) (s1 ⦇recvOuterFriendIDs := uu2⦈)"

"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇pendingSApiReqs := uu1⦈) (s1 ⦇pendingSApiReqs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇sApiReq := uu1⦈) (s1 ⦇sApiReq := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇serverApiIDs := uu1⦈) (s1 ⦇serverApiIDs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇serverPass := uu1⦈) (s1 ⦇serverPass := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇outerPostIDs := uu1⦈) (s1 ⦇outerPostIDs := uu2⦈)"

"⋀ uu1 uu2. eqButPID s s1 ⟹ eeqButPID uu1 uu2 ⟹ eqButPID (s ⦇outerPost := uu1⦈) (s1 ⦇outerPost := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇outerVis := uu1⦈) (s1 ⦇outerVis := uu2⦈)"

"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇outerOwner := uu1⦈) (s1 ⦇outerOwner := uu2⦈)"

"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇pendingCApiReqs := uu1⦈) (s1 ⦇pendingCApiReqs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇cApiReq := uu1⦈) (s1 ⦇cApiReq := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇clientApiIDs := uu1⦈) (s1 ⦇clientApiIDs := uu2⦈)"
"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇clientPass := uu1⦈) (s1 ⦇clientPass := uu2⦈)"

"⋀ uu1 uu2. eqButPID s s1 ⟹ uu1 = uu2 ⟹ eqButPID (s ⦇sharedWith := uu1⦈) (s1 ⦇sharedWith:= uu2⦈)"
unfolding eqButPID_def by auto


(* major *) lemma comReceivePost_step_eqButPID:
assumes a: "a = COMact (comReceivePost AID sp PID pst uid vs)"
and a1: "a1 = COMact (comReceivePost AID sp PID pst1 uid vs)"
and "step s a = (ou,s')" and "step s1 a1 = (ou1,s1')"
and "eqButPID s s1"
shows "eqButPID s' s1'"
using assms unfolding eqButPID_def eeqButPID_def
unfolding a a1 by (fastforce simp: com_defs fun_upd2_def)

(* major *) lemma eqButPID_step:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')"
and step1: "step s1 a = (ou1,s1')"
shows "eqButPID s' s1'"
proof -
  note [simp] = all_defs
  note * = step step1 ss1 eqButPID_stateSelectors[OF ss1] eqButPID_update_post[OF ss1]

  then show ?thesis
  proof (cases a)
    case (Sact x1)
    with * show ?thesis by (cases x1) auto
  next
    case (Cact x2)
    with * show ?thesis by (cases x2) auto
  next
    case (Dact x3)
    with * show ?thesis by (cases x3) auto
  next
    case (Uact x4)
    with * show ?thesis by (cases x4) auto
  next
    case (COMact x7)
    with * show ?thesis by (cases x7) auto
  qed auto
qed

end

end

Theory Post_Value_Setup_RECEIVER

(* The value setup for paper confidentiality *)
theory Post_Value_Setup_RECEIVER
  imports
    "../Safety_Properties"
    "Post_Observation_Setup_RECEIVER"
    "Post_Unwinding_Helper_RECEIVER"
begin

subsubsection ‹Value setup›

locale Post_RECEIVER = ObservationSetup_RECEIVER
begin

datatype "value" = PValR post ― ‹post content received from the issuer node›


fun φ :: "(state,act,out) trans ⇒ bool" where
"φ (Trans _ (COMact (comReceivePost aid sp pid pst uid vs)) ou _) =
(aid = AID ∧ pid = PID ∧ ou = outOK)"
|
"φ (Trans s _ _ s') = False"

lemma φ_def2:
"φ (Trans s a ou s') ⟷
 (∃uid p pst vs. a = COMact (comReceivePost AID p PID pst uid vs) ∧ ou = outOK)"
by (cases "Trans s a ou s'" rule: φ.cases) auto

lemma comReceivePost_out:
assumes 1: "step s a = (ou,s')" and a: "a = COMact (comReceivePost AID p PID pst uid vs)" and 2: "ou = outOK"
shows "p = serverPass s AID"
using 1 2 unfolding a by (auto simp: com_defs)

lemma φ_def3:
assumes "step s a = (ou,s')"
shows
"φ (Trans s a ou s') ⟷
 (∃uid pst vs. a = COMact (comReceivePost AID (serverPass s AID) PID pst uid vs) ∧ ou = outOK)"
unfolding φ_def2
using comReceivePost_out[OF assms]
by blast

lemma φ_cases:
assumes "φ (Trans s a ou s')"
and "step s a = (ou, s')"
and "reach s"
obtains
  (Recv) uid sp aID pID pst vs where "a = COMact (comReceivePost aID sp pID pst uid vs)" "ou = outOK"
                                 "sp = serverPass s AID"
                                  "aID = AID" "pID = PID"
proof -
  from assms(1) obtain sp pst uid vs where "a = COMact (comReceivePost AID sp PID pst uid vs) ∧ ou = outOK"
    unfolding φ_def2 by auto
  then show thesis proof -
    assume "a = COMact (comReceivePost AID sp PID pst uid vs) ∧ ou = outOK"
    with assms(2) show thesis by (intro Recv) (auto simp: com_defs)
  qed
qed


fun f :: "(state,act,out) trans ⇒ value" where
"f (Trans s (COMact (comReceivePost aid sp pid pst uid vs)) _ s') =
 (if aid = AID ∧ pid = PID then PValR pst else undefined)"
|
"f (Trans s _ _ s') = undefined"


sublocale Receiver_State_Equivalence_Up_To_PID .

lemma eqButPID_step_φ_imp:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and φ: "φ (Trans s a ou s')"
shows "φ (Trans s1 a ou1 s1')"
proof-
  have s's1': "eqButPID s' s1'"
  using eqButPID_step local.step ss1 step1 by blast
  show ?thesis using step step1 φ
  using eqButPID_stateSelectors[OF ss1]
  unfolding φ_def2
  by (auto simp: u_defs com_defs)
qed

lemma eqButPID_step_φ:
assumes s's1': "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
shows "φ (Trans s a ou s') = φ (Trans s1 a ou1 s1')"
by (metis eqButPID_step_φ_imp eqButPID_sym assms)


end

end
ody>

Theory Post_RECEIVER

theory Post_RECEIVER
  imports
    "Bounded_Deducibility_Security.Compositional_Reasoning"
    "Post_Observation_Setup_RECEIVER"
    "Post_Value_Setup_RECEIVER"
begin

subsubsection ‹Declassification bound›

text ‹We verify that a group of users of some node ‹i›,
allowed to take normal actions to the system and observe their outputs
\emph{and additionally allowed to observe communication},
can learn nothing about the updates to a post received from a remote node ‹j›
beyond the number of updates

unless:
\begin{itemize}
\item either a user in the group is the administrator
\item or a user in the group becomes a remote friend of the post's owner
\item or the group has at least one registered user and the post is being marked as "public"
\end{itemize}

See \cite{cosmedis-SandP2017} for more details.
›

context Post_RECEIVER
begin


fun T :: "(state,act,out) trans ⇒ bool" where
"T (Trans s a ou s') ⟷
 (∃ uid ∈ UIDs.
   uid ∈∈ userIDs s' ∧ PID ∈∈ outerPostIDs s' AID ∧
   (uid = admin s' ∨
    (AID,outerOwner s' AID PID) ∈∈ recvOuterFriendIDs s' uid ∨
    outerVis s' AID PID = PublicV))"

definition B :: "value list ⇒ value list ⇒ bool" where
"B vl vl1 ≡ length vl = length vl1"

sublocale BD_Security_IO where
istate = istate and step = step and
φ = φ and f = f and γ = γ and g = g and T = T and B = B
done

subsubsection ‹Unwinding proof›

lemma reach_PublicV_imples_FriendV[simp]:
assumes "reach s"
and "vis s pID ≠ PublicV"
shows "vis s pID = FriendV"
using assms reach_vis by auto

lemma reachNT_state:
assumes "reachNT s"
shows
"¬ (∃ uid ∈ UIDs.
   uid ∈∈ userIDs s ∧ PID ∈∈ outerPostIDs s AID ∧
   (uid = admin s ∨
    (AID,outerOwner s AID PID) ∈∈ recvOuterFriendIDs s uid ∨
     outerVis s AID PID = PublicV))"
using assms proof induct
  case (Step trn) thus ?case
  by (cases trn) auto
qed (simp add: istate_def)


(* major *) lemma eqButPID_step_γ_out:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sT: "reachNT s" and T: "¬ T (Trans s a ou s')"
and s1: "reach s1"
and γ: "γ (Trans s a ou s')"
shows "ou = ou1"
proof-
  have s'T: "reachNT s'" using step sT T using reachNT_PairI by blast
  note op = reachNT_state[OF s'T]
  note [simp] = all_defs
  note s = reachNT_reach[OF sT]
  note willUse =
    step step1 γ
    op
    reach_vis[OF s]
    eqButPID_stateSelectors[OF ss1] (* eqButPID_postSelectors[OF ss1] *)
    eqButPID_actions[OF ss1]
    eqButPID_update[OF ss1] (* eqButPID_setTextPost[OF ss1] *) eqButPID_not_PID[OF ss1]
  show ?thesis
  proof (cases a)
    case (Sact x1)
    with willUse show ?thesis by (cases x1) auto
  next
    case (Cact x2)
    with willUse show ?thesis by (cases x2) auto
  next
    case (Dact x3)
    with willUse show ?thesis by (cases x3) auto
  next
    case (Uact x4)
    with willUse show ?thesis by (cases x4) auto
  next
    case (Ract x5)
    with willUse show ?thesis
    proof (cases x5)
      case (rOPost uid p aid pid)
      with Ract willUse show ?thesis by (cases "aid = AID ∧ pid = PID") auto
    qed auto
  next
    case (Lact x6)
    with willUse show ?thesis by (cases x6) auto
  next
    case (COMact x7)
    with willUse show ?thesis by (cases x7) auto
  qed
qed


definition Δ0 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ0 s vl s1 vl1 ≡
 ¬ AID ∈∈ serverApiIDs s ∧
 s = s1 ∧
 length vl = length vl1"

definition Δ1 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ1 s vl s1 vl1 ≡
 AID ∈∈ serverApiIDs s ∧
 eqButPID s s1 ∧
 length vl = length vl1"

lemma istate_Δ0:
assumes B: "B vl vl1"
shows "Δ0 istate vl istate vl1"
using assms unfolding Δ0_def B_def istate_def by auto

lemma unwind_cont_Δ0: "unwind_cont Δ0 {Δ0,Δ1}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ0 s vl s1 vl1 ∨ Δ1 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ0 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s" and l: "length vl = length vl1"
  and AID: "¬ AID ∈∈ serverApiIDs s"
  using reachNT_reach unfolding Δ0_def by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof-
        have φ: "¬ φ ?trn" using AID step unfolding φ_def2(* [OF step] *) by (auto simp: u_defs com_defs)
        hence vl': "vl' = vl" using c φ unfolding consume_def by simp
        have ?match proof(cases "∃ p. a = COMact (comConnectServer AID p) ∧ ou = outOK")
          case True
          then obtain p where a: "a = COMact (comConnectServer AID p)" and ou: "ou = outOK" by auto
          have AID': "AID ∈∈ serverApiIDs s'"
          using step AID unfolding a ou by (auto simp: com_defs)
          note uid = reachNT_state[OF rsT]
          show ?thesis proof
            show "validTrans ?trn1" unfolding ss1 using step by simp
          next
            show "consume ?trn1 vl1 vl1" using φ unfolding consume_def ss1 by auto
          next
            show "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            have "Δ1 s' vl' s' vl1" using l AID' c unfolding ss1 Δ1_def vl' by auto
            thus "?Δ s' vl' s' vl1" by simp
          qed
        next
          case False note a = False
          have AID': "¬ AID ∈∈ serverApiIDs s'"
            using step AID a
            apply(cases a)
            subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
            subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
            subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
            subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
            subgoal by auto
            subgoal by auto
            subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
            done
          show ?thesis proof
            show "validTrans ?trn1" unfolding ss1 using step by simp
          next
            show "consume ?trn1 vl1 vl1" using φ unfolding consume_def ss1 by auto
          next
            show "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            have "Δ0 s' vl' s' vl1" using a AID' l unfolding Δ0_def vl' ss1 by simp
            thus "?Δ s' vl' s' vl1" by simp
          qed
        qed
        thus ?thesis by simp
      qed
    qed
  thus ?thesis using l by auto
  qed
qed

(* lemma setTextPost_absorb[simp]:
"setTextPost (setTextPost pst pst) pst1 = setTextPost pst pst1"
by (cases pst) auto
*)

lemma unwind_cont_Δ1: "unwind_cont Δ1 {Δ1}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ1 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ1 s vl s1 vl1"
  hence rs: "reach s" and ss1: "eqButPID s s1"
  and l: "length vl = length vl1" and AID: "AID ∈∈ serverApiIDs s"
  using reachNT_reach unfolding Δ1_def by auto
  have AID1: "AID ∈∈ serverApiIDs s1" using eqButPID_stateSelectors[OF ss1] AID by auto
  (* have own: "owner s PID ∈ set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  hence own1: "owner s1 PID ∈ set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto *)
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof-
        have ?match proof(cases "∃ p pst uid vs. a = COMact (comReceivePost AID p PID pst uid vs) ∧ ou = outOK")
          case True
          then obtain p pst uid vs where
          a: "a = COMact (comReceivePost AID p PID pst uid vs)" and ou: "ou = outOK" by auto
          have p: "p = serverPass s AID" using comReceivePost_out[OF step a ou] .
          have p1: "p = serverPass s1 AID" using p ss1 eqButPID_stateSelectors by auto
          have φ: "φ ?trn" using a ou step φ_def2 by auto
          obtain v where vl: "vl = v # vl'" and f: "f ?trn = v"
          using c φ unfolding consume_def by (cases vl) auto
          have AID': "AID ∈∈ serverApiIDs s'" using step AID unfolding a ou by (auto simp: com_defs)
          note uid = reachNT_state[OF rsT]
          obtain v1 vl1' where vl1: "vl1 = v1 # vl1'" using l unfolding vl by (cases vl1) auto
          obtain pst1 where v1: "v1 = PValR pst1" by (cases v1) auto
          define a1 where "a1 ≡ COMact (comReceivePost AID p PID pst1 uid vs)" note a1 = this
          obtain s1' where step1: "step s1 a1 = (outOK, s1')" using AID1 unfolding a1_def p1 by (simp add: com_defs)
          have s's1': "eqButPID s' s1'" using comReceivePost_step_eqButPID[OF a _ step step1 ss1] a1 by simp
          let ?trn1 = "Trans s1 a1 outOK s1'"
          have φ1: "φ ?trn1" unfolding φ_def2(* [OF step1] *) unfolding a1 by auto
          have f1: "f ?trn1 = v1" unfolding a1 v1 by simp
          show ?thesis proof
            show "validTrans ?trn1" using step1 by simp
          next
            show "consume ?trn1 vl1 vl1'" using φ1 f1 unfolding consume_def ss1 vl1 by simp
          next
            show "γ ?trn = γ ?trn1" unfolding a a1 by simp
          next
            assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding a a1 ou by simp
          next
            show "Δ1 s' vl' s1' vl1'" using l AID' c s's1' unfolding Δ1_def vl vl1 by simp
          qed
        next
          case False note a = False
          obtain s1' ou1 where step1: "step s1 a = (ou1, s1')" by fastforce
          let ?trn1 = "Trans s1 a ou1 s1'"
          have φ: "¬ φ ?trn" using a step φ_def2 by auto
          have φ1: "¬ φ ?trn1" using φ ss1 step step1 eqButPID_step_φ by blast
          have s's1': "eqButPID s' s1'" using ss1 step step1 eqButPID_step by blast
          have ouou1: "γ ?trn ⟹ ou = ou1" using eqButPID_step_γ_out ss1 step step1 T rs1 rsT by blast
          have AID': "AID ∈∈ serverApiIDs s'" using AID step rs using IDs_mono by auto
          have vl': "vl' = vl" using c φ unfolding consume_def by simp
          show ?thesis proof
            show "validTrans ?trn1" using step1 by simp
          next
            show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def ss1 by auto
          next
            show 1: "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" hence "ou = ou1" using ouou1 by auto
            thus "g ?trn = g ?trn1" using ouou1 by (cases a) auto
          next
            show "Δ1 s' vl' s1' vl1" using a l s's1' AID' unfolding Δ1_def vl' by simp
          qed
        qed
        thus ?thesis by simp
      qed
    qed
  thus ?thesis using l by auto
  qed
qed

definition Gr where
"Gr =
 {
 (Δ0, {Δ0,Δ1}),
 (Δ1, {Δ1})
 }"


theorem Post_secure: secure
apply (rule unwind_decomp_secure_graph[of Gr Δ0])
unfolding Gr_def
apply (simp, smt insert_subset order_refl)
using istate_Δ0 unwind_cont_Δ0 unwind_cont_Δ1
unfolding Gr_def by auto


end (* context Post_RECEIVER *)

end
ody>

Theory Post_COMPOSE2

theory Post_COMPOSE2
imports
  "Post_ISSUER"
  "Post_RECEIVER"
  "BD_Security_Compositional.Composing_Security"
begin

subsection ‹Confidentiality for the (binary) issuer-receiver composition›

type_synonym ttrans = "(state, act, out) trans"
type_synonym value1 = Post_ISSUER.value  type_synonym value2 = Post_RECEIVER.value
type_synonym obs1 = Post_Observation_Setup_ISSUER.obs
type_synonym obs2 = Post_Observation_Setup_RECEIVER.obs

(* irrelevant for the security conditions: *)
datatype cval = PValC post
type_synonym cobs = "obs1 × obs2"

locale Post_COMPOSE2 =
  Iss: Post_ISSUER UIDs PID +
  Rcv: Post_RECEIVER UIDs2 PID AID1
for UIDs :: "userID set" and UIDs2 :: "userID set" and
   AID1 :: "apiID" and PID :: "postID"
+ fixes AID2 :: "apiID"
begin

abbreviation "φ1 ≡ Iss.φ"  abbreviation "f1 ≡ Iss.f" abbreviation "γ1 ≡ Iss.γ"  abbreviation "g1 ≡ Iss.g"
  abbreviation "T1 ≡ Iss.T"  abbreviation "B1 ≡ Iss.B"
abbreviation "φ2 ≡ Rcv.φ"  abbreviation "f2 ≡ Rcv.f" abbreviation "γ2 ≡ Rcv.γ"  abbreviation "g2 ≡ Rcv.g"
  abbreviation "T2 ≡ Rcv.T"  abbreviation "B2 ≡ Rcv.B"

(* Recall that we assume that the system prevents communication if error occurs: *)
fun isCom1 :: "ttrans ⇒ bool" where
 "isCom1 (Trans s (COMact ca1) ou1 s') = (ou1 ≠ outErr)"
|"isCom1 _ = False"

fun isCom2 :: "ttrans ⇒ bool" where
 "isCom2 (Trans s (COMact ca2) ou2 s') = (ou2 ≠ outErr)"
|"isCom2 _ = False"

fun isComV1 :: "value1 ⇒ bool" where
 "isComV1 (Iss.PValS aid1 txt1) = True"
|"isComV1 _ = False"

fun isComV2 :: "value2 ⇒ bool" where
 "isComV2 (Rcv.PValR txt2) = True"
(* |"isComV2 _ = False" *)

fun syncV :: "value1 ⇒ value2 ⇒ bool" where
 "syncV (Iss.PValS aid1 txt1) (Rcv.PValR txt2) = (txt1 = txt2)"
|"syncV _ _ = False"

(* irrelevant for the security conditions: *)
fun cmpV :: "value1 ⇒ value2 ⇒ cval"  where
 "cmpV (Iss.PValS aid1 txt1) (Rcv.PValR txt2) = PValC txt1"
|"cmpV _ _ = undefined"

fun isComO1 :: "obs1 ⇒ bool" where
 "isComO1 (COMact ca1, ou1) = (ou1 ≠ outErr)"
|"isComO1 _ = False"

fun isComO2 :: "obs2 ⇒ bool" where
 "isComO2 (COMact ca2, ou2) = (ou2 ≠ outErr)"
|"isComO2 _ = False"

fun comSyncOA :: "out ⇒ comActt ⇒ bool" where
 "comSyncOA (O_sendServerReq (aid2, reqInfo1)) (comReceiveClientReq aid1 reqInfo2) =
   (aid1 = AID1 ∧ aid2 = AID2 ∧ reqInfo1 = reqInfo2)"
|"comSyncOA (O_connectClient (aid2, sp1)) (comConnectServer aid1 sp2) =
   (aid1 = AID1 ∧ aid2 = AID2 ∧ sp1 = sp2)"
|"comSyncOA (O_sendPost (aid2, sp1, pid1, pst1, uid1, vis1)) (comReceivePost aid1 sp2 pid2 pst2 uid2 vis2) =
   (aid1 = AID1 ∧ aid2 = AID2 ∧ (pid1, pst1, uid1, vis1) = (pid2, pst2, uid2, vis2))"
|"comSyncOA (O_sendCreateOFriend (aid2, sp1, uid1, uid1')) (comReceiveCreateOFriend aid1 sp2 uid2 uid2') =
   (aid1 = AID1 ∧ aid2 = AID2 ∧ (uid1, uid1') = (uid2, uid2'))"
|"comSyncOA (O_sendDeleteOFriend (aid2, sp1, uid1, uid1')) (comReceiveDeleteOFriend aid1 sp2 uid2 uid2') =
   (aid1 = AID1 ∧ aid2 = AID2 ∧ (uid1, uid1') = (uid2, uid2'))"
|"comSyncOA _ _ = False"

fun syncO :: "obs1 ⇒ obs2 ⇒ bool" where
 "syncO (COMact ca1, ou1) (COMact ca2, ou2) =
  (ou1 ≠ outErr ∧ ou2 ≠ outErr ∧
   (comSyncOA ou1 ca2 ∨ comSyncOA ou2 ca1)
  )"
|"syncO _ _ = False"

fun sync :: "ttrans ⇒ ttrans ⇒ bool" where
"sync (Trans s1 a1 ou1 s1') (Trans s2 a2 ou2 s2') = syncO (a1, ou1) (a2, ou2)"

(* irrelevant for the security conditions: *)
definition cmpO :: "obs1 ⇒ obs2 ⇒ cobs"  where
"cmpO o1 o2 ≡ (o1,o2)"


(*  *)

lemma isCom1_isComV1:
assumes "validTrans trn1" and "reach (srcOf trn1)" and "φ1 trn1"
shows "isCom1 trn1 ⟷ isComV1 (f1 trn1)"
using assms apply(cases trn1) by (auto simp: Iss.φ_def2 split: prod.splits)

lemma isCom1_isComO1:
assumes "validTrans trn1" and "reach (srcOf trn1)" and "γ1 trn1"
shows "isCom1 trn1 ⟷ isComO1 (g1 trn1)"
using assms by (cases trn1 rule: isCom1.cases) auto

lemma isCom2_isComV2:
assumes "validTrans trn2" and "reach (srcOf trn2)" and "φ2 trn2"
shows "isCom2 trn2 ⟷ isComV2 (f2 trn2)"
using assms apply(cases trn2) by (auto simp: Rcv.φ_def2 split: prod.splits)

lemma isCom2_isComO2:
assumes "validTrans trn2" and "reach (srcOf trn2)" and "γ2 trn2"
shows "isCom2 trn2 ⟷ isComO2 (g2 trn2)"
using assms by (cases trn2 rule: isCom2.cases) auto

lemma sync_syncV:
assumes "validTrans trn1" and "reach (srcOf trn1)"
and "validTrans trn2" and "reach (srcOf trn2)"
and "isCom1 trn1" and "isCom2 trn2" and "φ1 trn1" and "φ2 trn2"
and "sync trn1 trn2"
shows "syncV (f1 trn1) (f2 trn2)"
using assms apply(cases trn1, cases trn2)
by (auto simp: Iss.φ_def2 Rcv.φ_def2 split: prod.splits)

lemma sync_syncO:
assumes "validTrans trn1" and "reach (srcOf trn1)"
and "validTrans trn2" and "reach (srcOf trn2)"
and "isCom1 trn1" and "isCom2 trn2" and "γ1 trn1" and "γ2 trn2"
and "sync trn1 trn2"
shows "syncO (g1 trn1) (g2 trn2)"
proof(cases trn1)
  case (Trans s1 a1 ou1 s1') note trn1 = Trans
  show ?thesis proof(cases trn2)
    case (Trans s2 a2 ou2 s2') note trn2 = Trans
    show ?thesis
    proof(cases a1)
      case (COMact ca1) note a1 = COMact
      show ?thesis
      proof(cases a2)
        case (COMact ca2) note a2 = COMact
        show ?thesis
        using assms unfolding trn1 trn2 a1 a2
        apply(cases ca1) by (cases ca2, auto split: prod.splits)+
      qed(insert assms, unfold trn1 trn2, auto)
    qed(insert assms, unfold trn1 trn2, auto)
  qed
qed

lemma sync_φ1_φ2:
assumes v1: "validTrans trn1" and r1: "reach (srcOf trn1)"
and v2: "validTrans trn2" and s2: "reach (srcOf trn2)"
and c1: "isCom1 trn1" and c2: "isCom2 trn2"
and sn: "sync trn1 trn2"
shows "φ1 trn1 ⟷ φ2 trn2" (is "?A ⟷ ?B")
proof(cases trn1)
  case (Trans s1 a1 ou1 s1') note trn1 = Trans
  hence step1: "step s1 a1 = (ou1,s1')" using v1 by auto
  show ?thesis proof(cases trn2)
    case (Trans s2 a2 ou2 s2') note trn2 = Trans
    hence step2: "step s2 a2 = (ou2,s2')" using v2 by auto
    show ?thesis
    proof(cases a1)
      case (COMact ca1) note a1 = COMact
      show ?thesis
      proof(cases a2)
        case (COMact ca2) note a2 = COMact

        have "?A ⟷ (∃aid1. ca1 =
             (comSendPost (admin s1) (pass s1 (admin s1)) aid1
               PID) ∧
            ou1 =
            O_sendPost
             (aid1, clientPass s1 aid1, PID, post s1 PID,
              owner s1 PID, vis s1 PID))"
        using c1 unfolding trn1 Iss.φ_def3[OF step1] unfolding a1 by auto
        also have "… ⟷ (∃uid2 pst2 vs2.
        ca2 = comReceivePost AID1 (serverPass s2 AID1) PID pst2 uid2 vs2 ∧ ou2 = outOK)"
        using sn step1 step2 unfolding trn1 trn2 a1 a2
        apply(cases ca1) by (cases ca2, auto simp: all_defs)+
        also have "… ⟷ ?B"
        using c2 unfolding trn2 Rcv.φ_def3[OF step2] unfolding a2 by auto
        finally show ?thesis .
      qed(insert assms, unfold trn1 trn2, auto)
    qed(insert assms, unfold trn1 trn2, auto)
  qed
qed

lemma textPost_textPost_cong[intro]:
assumes "textPost pst1 = textPost pst2"
and "setTextPost pst1 emptyText = setTextPost pst2 emptyText"
shows "pst1 = pst2"
using assms by (cases pst1, cases pst2) auto

lemma sync_φ_γ:
assumes "validTrans trn1" and "reach (srcOf trn1)"
and "validTrans trn2" and "reach (srcOf trn2)"
and "isCom1 trn1" and "isCom2 trn2"
and "γ1 trn1" and "γ2 trn2"
and so: "syncO (g1 trn1) (g2 trn2)"
and "φ1 trn1 ⟹ φ2 trn2 ⟹ syncV (f1 trn1) (f2 trn2)"
shows "sync trn1 trn2"
proof(cases trn1, cases trn2)
  fix s1 a1 ou1 s1' s2 a2 ou2 s2'
  assume trn1: "trn1 = Trans s1 a1 ou1 s1'"
  and trn2: "trn2 = Trans s2 a2 ou2 s2'"
  hence step1: "step s1 a1 = (ou1,s1')" and step2: "step s2 a2 = (ou2,s2')" using assms by auto
  show ?thesis
  proof(cases a1)
    case (COMact ca1) note a1 = COMact
    show ?thesis
    proof(cases a2)
      case (COMact ca2) note a2 = COMact
      show ?thesis
      proof(cases ca1)   term comReceivePost
        case (comSendPost uid1 p1 aid1 pid) note ca1 = comSendPost
        then obtain pst where p1: "p1 = pass s1 (admin s1)" and
        aid1: "aid1 = AID2" and ou2: "ou2 = outOK" and ou1: "ou1 ≠ outErr" and
        ca2: "ca2 = comReceivePost AID1 (serverPass s2 AID1) pid pst (owner s1 pid) (vis s1 pid)"
        using so step1 step2 unfolding trn1 trn2 a1 a2 ca1
        by (cases ca2, auto simp: all_defs)
        have ou1: "ou1 = O_sendPost (AID2,clientPass s1 AID2,pid, post s1 pid, owner s1 pid, vis s1 pid)"
        using step1 ou1 unfolding a1 ca1 aid1 by (auto simp: all_defs)
        show ?thesis proof(cases "pid = PID")
          case False thus ?thesis using so step1 step2 unfolding trn1 trn2 a1 a2 ca1 ca2
          by (auto simp: all_defs)
        next
          case True  note pid = True
          hence "φ1 trn1 ∧ φ2 trn2" using ou1 ou2 unfolding trn1 trn2 a1 a2 ca1 ca2 by auto
          hence "syncV (f1 trn1) (f2 trn2)" using assms by simp
          hence pst: "pst = post s1 PID" using pid unfolding trn1 trn2 a1 a2 ca1 ca2 aid1 ou1 by auto
          show ?thesis unfolding trn1 trn2 a1 a2 ca1 ca2 ou1 ou2 pst pid by auto
        qed
      qed(insert so step1 step2, unfold trn1 trn2 a1 a2, (cases ca2, auto simp: all_defs)+)
    qed(insert assms, unfold trn1 trn2, auto)
  qed(insert assms, unfold trn1 trn2, auto)
qed

lemma isCom1_γ1:
assumes "validTrans trn1" and "reach (srcOf trn1)" and "isCom1 trn1"
shows "γ1 trn1"
proof(cases trn1)
  case (Trans s1 a1 ou1 s1')
  thus ?thesis using assms by (cases a1) auto
qed

lemma isCom2_γ2:
assumes "validTrans trn2" and "reach (srcOf trn2)" and "isCom2 trn2"
shows "γ2 trn2"
proof(cases trn2)
  case (Trans s2 a2 ou2 s2')
  thus ?thesis using assms by (cases a2) auto
qed

lemma isCom2_V2:
assumes "validTrans trn2" and "reach (srcOf trn2)" and "φ2 trn2"
shows "isCom2 trn2"
proof(cases trn2)
  case (Trans s2 a2 ou2 s2') note trn2 = Trans
  show ?thesis
  proof(cases a2)
    case (COMact ca2)
    thus ?thesis using assms trn2 by (cases ca2) auto
  qed(insert assms trn2, auto)
qed

end (* context Post_COMPOSE2 *)


sublocale Post_COMPOSE2 < BD_Security_TS_Comp where
  istate1 = istate and validTrans1 = validTrans and srcOf1 = srcOf and tgtOf1 = tgtOf
    and φ1 = φ1 and f1 = f1 and γ1 = γ1 and g1 = g1 and T1 = T1 and B1 = B1
  and
  istate2 = istate and validTrans2 = validTrans and srcOf2 = srcOf and tgtOf2 = tgtOf
    and φ2 = φ2 and f2 = f2 and γ2 = γ2 and g2 = g2 and T2 = T2 and B2 = B2
  and isCom1 = isCom1 and isCom2 = isCom2 and sync = sync
  and isComV1 = isComV1 and isComV2 = isComV2 and syncV = syncV
  and isComO1 = isComO1 and isComO2 = isComO2 and syncO = syncO
  (*and cmpV = cmpV and cmpO = cmpO *)
apply standard
using isCom1_isComV1 isCom1_isComO1 isCom2_isComV2 isCom2_isComO2
  sync_syncV sync_syncO
apply auto
apply (meson sync_φ1_φ2, meson sync_φ1_φ2)
using sync_φ_γ apply auto
using isCom1_γ1 isCom2_γ2 isCom2_V2 apply auto
by (meson isCom2_V2)


context Post_COMPOSE2
begin

theorem secure: "secure"
  using secure1_secure2_secure[OF Iss.Post_secure Rcv.Post_secure] .

end  (* context Post_COMPOSE2 *)

end
dy>

Theory Post_Network

theory Post_Network
imports
  "../API_Network"
  "Post_ISSUER"
  "Post_RECEIVER"
  "BD_Security_Compositional.Composing_Security_Network"
begin

subsection ‹Confidentiality for the N-ary composition›

type_synonym ttrans = "(state, act, out) trans"
type_synonym obs = Post_Observation_Setup_ISSUER.obs
type_synonym "value" = "Post_ISSUER.value + Post_RECEIVER.value"

lemma value_cases:
fixes v :: "value"
obtains (PVal) pst where "v = Inl (Post_ISSUER.PVal pst)"
      | (PValS) aid pst where "v = Inl (Post_ISSUER.PValS aid pst)"
      | (PValR) pst where "v = Inr (Post_RECEIVER.PValR pst)"
proof (cases v)
  case (Inl vl) then show thesis using PVal PValS by (cases vl rule: Post_ISSUER.value.exhaust) auto next
  case (Inr vr) then show thesis using PValR by (cases vr rule: Post_RECEIVER.value.exhaust) auto
qed

locale Post_Network = Network
+ fixes UIDs :: "apiID ⇒ userID set"
  and AID :: "apiID" and PID :: "postID"
  assumes AID_in_AIDs: "AID ∈ AIDs"
begin

sublocale Iss: Post_ISSUER "UIDs AID" PID .

abbreviation φ :: "apiID ⇒ (state, act, out) trans ⇒ bool"
where "φ aid trn ≡ (if aid = AID then Iss.φ trn else Post_RECEIVER.φ PID AID trn)"

abbreviation f :: "apiID ⇒ (state, act, out) trans ⇒ value"
where "f aid trn ≡ (if aid = AID then Inl (Iss.f trn) else Inr (Post_RECEIVER.f PID AID trn))"

abbreviation γ :: "apiID ⇒ (state, act, out) trans ⇒ bool"
where "γ aid trn ≡ (if aid = AID then Iss.γ trn else ObservationSetup_RECEIVER.γ (UIDs aid) trn)"

abbreviation g :: "apiID ⇒ (state, act, out) trans ⇒ obs"
where "g aid trn ≡ (if aid = AID then Iss.g trn else ObservationSetup_RECEIVER.g PID AID trn)"

abbreviation T :: "apiID ⇒ (state, act, out) trans ⇒ bool"
where "T aid trn ≡ (if aid = AID then Iss.T trn else Post_RECEIVER.T (UIDs aid) PID AID trn)"

abbreviation B :: "apiID ⇒ value list ⇒ value list ⇒ bool"
where "B aid vl vl1 ≡
  (if aid = AID then list_all isl vl ∧ list_all isl vl1 ∧ Iss.B (map projl vl) (map projl vl1)
   else list_all (Not o isl) vl ∧ list_all (Not o isl) vl1 ∧ Post_RECEIVER.B (map projr vl) (map projr vl1))"

fun comOfV :: "apiID ⇒ value ⇒ com" where
  "comOfV aid (Inl (Post_ISSUER.PValS aid' pst)) = (if aid' ≠ aid then Send else Internal)"
| "comOfV aid (Inl (Post_ISSUER.PVal pst)) = Internal"
| "comOfV aid (Inr v) = Recv"

fun tgtNodeOfV :: "apiID ⇒ value ⇒ apiID" where
  "tgtNodeOfV aid (Inl (Post_ISSUER.PValS aid' pst)) = aid'"
| "tgtNodeOfV aid (Inl (Post_ISSUER.PVal pst)) = undefined"
| "tgtNodeOfV aid (Inr v) = AID"

definition syncV :: "apiID ⇒ value ⇒ apiID ⇒ value ⇒ bool" where
  "syncV aid1 v1 aid2 v2 =
    (∃pst. aid1 = AID ∧ v1 = Inl (Post_ISSUER.PValS aid2 pst) ∧ v2 = Inr (Post_RECEIVER.PValR pst))"

lemma syncVI: "syncV AID (Inl (Post_ISSUER.PValS aid' pst)) aid' (Inr (Post_RECEIVER.PValR pst))"
unfolding syncV_def by auto

lemma syncVE:
assumes "syncV aid1 v1 aid2 v2"
obtains pst where "aid1 = AID" "v1 = Inl (Post_ISSUER.PValS aid2 pst)" "v2 = Inr (Post_RECEIVER.PValR pst)"
using assms unfolding syncV_def by auto

fun getTgtV where
  "getTgtV (Inl (Post_ISSUER.PValS aid pst)) = Inr (Post_RECEIVER.PValR pst)"
| "getTgtV v = v"

lemma comOfV_AID:
  "comOfV AID v = Send ⟷ isl v ∧ Iss.isPValS (projl v) ∧ Iss.PValS_tgtAPI (projl v) ≠ AID"
  "comOfV AID v = Recv ⟷ Not (isl v)"
by (cases v rule: value_cases; auto)+

lemmas φ_defs = Post_RECEIVER.φ_def2 Iss.φ_def2

sublocale Net: BD_Security_TS_Network_getTgtV
where istate = "λ_. istate" and validTrans = validTrans and srcOf = "λ_. srcOf" and tgtOf = "λ_. tgtOf"
  and nodes = AIDs and comOf = comOf and tgtNodeOf = tgtNodeOf
  and sync = sync and φ = φ and f = f and γ = γ and g = g and T = T and B = B
  and comOfV = comOfV and tgtNodeOfV = tgtNodeOfV and syncV = syncV
  and comOfO = comOfO and tgtNodeOfO = tgtNodeOfO and syncO = syncO (*and cmpO = cmpO*)
  and source = AID and getTgtV = getTgtV
using AID_in_AIDs proof (unfold_locales, goal_cases)
  case (1 nid trn) then show ?case by (cases trn) (auto simp: φ_defs split: prod.splits) next
  case (2 nid trn) then show ?case by (cases trn) (auto simp: φ_defs split: prod.splits) next
  case (3 nid trn)
    interpret Sink: Post_RECEIVER "UIDs nid" PID AID .
    show ?case using 3 by (cases "(nid,trn)" rule: tgtNodeOf.cases) (auto split: prod.splits) next
  case (4 nid trn)
    interpret Sink: Post_RECEIVER "UIDs nid" PID AID .
    show ?case using 4 by (cases "(nid,trn)" rule: tgtNodeOf.cases) (auto split: prod.splits) next
  case (5 nid1 trn1 nid2 trn2)
    interpret Sink1: Post_RECEIVER "UIDs nid1" PID AID .
    interpret Sink2: Post_RECEIVER "UIDs nid2" PID AID .
    show ?case using 5 by (elim sync_cases) (auto intro: syncVI) next
  case (6 nid1 trn1 nid2 trn2)
    interpret Sink1: Post_RECEIVER "UIDs nid1" PID AID .
    interpret Sink2: Post_RECEIVER "UIDs nid2" PID AID .
    show ?case using 6 by (elim sync_cases) auto next
  case (7 nid1 trn1 nid2 trn2)
    interpret Sink1: Post_RECEIVER "UIDs nid1" PID AID .
    interpret Sink2: Post_RECEIVER "UIDs nid2" PID AID .
    show ?case using 7 by (elim sync_cases) (auto split: prod.splits, auto simp: sendPost_def) next
  case (8 nid1 trn1 nid2 trn2)
    interpret Sink1: Post_RECEIVER "UIDs nid1" PID AID .
    interpret Sink2: Post_RECEIVER "UIDs nid2" PID AID .
    show ?case using 8
      apply (elim syncO_cases; cases trn1; cases trn2)
          apply (auto simp: Iss.g_simps ObservationSetup_RECEIVER.g_simps split: prod.splits)
      apply (auto simp: sendPost_def split: prod.splits elim: syncVE)[]
      done next
  case (9 nid trn)
    then show ?case
      by (cases "(nid,trn)" rule: tgtNodeOf.cases)
         (auto simp: ObservationSetup_RECEIVER.γ.simps) next
  case (10 nid trn) then show ?case by (cases trn) (auto simp: φ_defs) next
  case (11 vSrc nid vn) then show ?case by (cases vSrc rule: value_cases) (auto simp: syncV_def) next
  case (12 vSrc nid vn) then show ?case by (cases vSrc rule: value_cases) (auto simp: syncV_def)
qed

lemma list_all_Not_isl_projectSrcV: "list_all (Not o isl) (Net.projectSrcV aid vlSrc)"
proof (induction vlSrc)
  case (Cons vSrc vlSrc') then show ?case by (cases vSrc rule: value_cases) auto
qed auto

context
fixes AID' :: apiID
assumes AID': "AID' ∈ AIDs - {AID}"
begin

interpretation Sink: Post_RECEIVER "UIDs AID'" PID AID by unfold_locales

lemma Source_B_Sink_B_aux:
assumes "list_all isl vl"
and "list_all isl vl1"
and "map Iss.PValS_tgtAPI (filter Iss.isPValS (map projl vl)) =
     map Iss.PValS_tgtAPI (filter Iss.isPValS (map projl vl1))"
shows "length (map projr (Net.projectSrcV AID' vl)) = length (map projr (Net.projectSrcV AID' vl1))"
using assms proof (induction vl vl1 rule: list22_induct)
  case (ConsCons v vl v1 vl1)
    consider (SendSend) aid pst pst1 where "v = Inl (Iss.PValS aid pst)" "v1 = Inl (Iss.PValS aid pst1)"
           | (Internal) "comOfV AID v = Internal" "¬Iss.isPValS (projl v)"
           | (Internal1) "comOfV AID v1 = Internal" "¬Iss.isPValS (projl v1)"
      using ConsCons(4-6) by (cases v rule: value_cases; cases v1 rule: value_cases) auto
    then show ?case proof cases
      case (SendSend) then show ?thesis using ConsCons.IH(1) ConsCons.prems by auto
    next
      case (Internal) then show ?thesis using ConsCons.IH(2)[of "v1 # vl1"] ConsCons.prems by auto
    next
      case (Internal1) then show ?thesis using ConsCons.IH(3)[of "v # vl"] ConsCons.prems by auto
    qed
qed (auto simp: comOfV_AID)

lemma Source_B_Sink_B:
assumes "B AID vl vl1"
shows "Sink.B (map projr (Net.projectSrcV AID' vl)) (map projr (Net.projectSrcV AID' vl1))"
using assms Source_B_Sink_B_aux by (auto simp: Iss.B_def Sink.B_def)

end

lemma map_projl_Inl: "map (projl o Inl) vl = vl"
by (induction vl) auto

lemma these_map_Inl_projl: "list_all isl vl ⟹ these (map (Some o Inl o projl) vl) = vl"
by (induction vl) auto

lemma map_projr_Inr: "map (projr o Inr) vl = vl"
by (induction vl) auto

lemma these_map_Inr_projr: "list_all (Not o isl) vl ⟹ these (map (Some o Inr o projr) vl) = vl"
by (induction vl) auto

sublocale BD_Security_TS_Network_Preserve_Source_Security_getTgtV
where istate = "λ_. istate" and validTrans = validTrans and srcOf = "λ_. srcOf" and tgtOf = "λ_. tgtOf"
  and nodes = AIDs and comOf = comOf and tgtNodeOf = tgtNodeOf
  and sync = sync and φ = φ and f = f and γ = γ and g = g and T = T and B = B
  and comOfV = comOfV and tgtNodeOfV = tgtNodeOfV and syncV = syncV
  and comOfO = comOfO and tgtNodeOfO = tgtNodeOfO and syncO = syncO (*and cmpO = cmpO*)
  and source = AID and getTgtV = getTgtV
proof (unfold_locales, goal_cases)
  case 1 show ?case using AID_in_AIDs . next
  case 2
    interpret Iss': BD_Security_TS_Trans
      istate System_Specification.validTrans srcOf tgtOf Iss.φ Iss.f Iss.γ Iss.g Iss.T Iss.B
      istate System_Specification.validTrans srcOf tgtOf Iss.φ "λtrn. Inl (Iss.f trn)" Iss.γ Iss.g Iss.T "B AID"
      id id Some "Some o Inl"
    proof (unfold_locales, goal_cases)
      case (11 vl' vl1' tr) then show ?case
        by (intro exI[of _ "map projl vl1'"]) (auto simp: map_projl_Inl these_map_Inl_projl)
    qed auto
    show ?case using Iss.Post_secure Iss'.translate_secure by auto
next
  case (3 aid tr vl' vl1)
    then show ?case
      using Source_B_Sink_B[of aid "(Net.lV AID tr)" vl1] list_all_Not_isl_projectSrcV
      by auto
qed

theorem secure: "secure"
proof (intro preserve_source_secure ballI)
  fix aid
  assume aid: "aid ∈ AIDs - {AID}"
  interpret Node: Post_RECEIVER "UIDs aid" PID AID .
  interpret Node': BD_Security_TS_Trans
    istate System_Specification.validTrans srcOf tgtOf Node.φ Node.f Node.γ Node.g Node.T Node.B
    istate System_Specification.validTrans srcOf tgtOf Node.φ "λtrn. Inr (Node.f trn)" Node.γ Node.g Node.T "B aid"
    id id Some "Some o Inr"
  proof (unfold_locales, goal_cases)
    case (11 vl' vl1' tr) then show ?case using aid
      by (intro exI[of _ "map projr vl1'"]) (auto simp: map_projr_Inr these_map_Inr_projr)
  qed auto
  show "Net.lsecure aid"
    using aid Node.Post_secure Node'.translate_secure by auto
qed

end  (* context Post_Network *)

end
itle>

Theory DYNAMIC_Post_Value_Setup_ISSUER

(* The value setup for post confidentiality *)
theory DYNAMIC_Post_Value_Setup_ISSUER
  imports
    "../Safety_Properties"
    "Post_Observation_Setup_ISSUER"
    "Post_Unwinding_Helper_ISSUER"
begin

subsection ‹Variation with dynamic declassification trigger›

text ‹This section formalizes the ``dynamic'' variation of one
post confidentiality properties, as described in \cite[Appendix C]{cosmedis-SandP2017}.
›

locale Post = ObservationSetup_ISSUER
begin

subsubsection‹Issuer value setup›

datatype "value" =
  isPVal: PVal post ― ‹updating the post content locally›
| isPValS: PValS (tgtAPI: apiID) post ― ‹sending the post to another node›
| isOVal: OVal bool ― ‹change in the dynamic declassification trigger condition›

text ‹The dynamic declassification trigger condition holds, i.e.~the access window to the
confidential information is open, when the post is public or one of the observers is the
administrator, the post's owner, or a friend of the post's owner.›

definition "open" where
"open s ≡
 ∃ uid ∈ UIDs.
   uid ∈∈ userIDs s ∧ PID ∈∈ postIDs s ∧
   (uid = admin s ∨ uid = owner s PID ∨ uid ∈∈ friendIDs s (owner s PID) ∨
    vis s PID = PublicV)"

sublocale Issuer_State_Equivalence_Up_To_PID .

lemma eqButPID_open:
assumes "eqButPID s s1"
shows "open s ⟷ open s1"
using eqButPID_stateSelectors[OF assms] (* eqButPID_postSelectors[OF assms] *)
unfolding open_def by auto

lemma not_open_eqButPID:
assumes 1: "¬ open s" and 2: "eqButPID s s1"
shows "¬ open s1"
using 1 unfolding eqButPID_open[OF 2] .

lemma step_isCOMact_open:
assumes "step s a = (ou, s')"
and "isCOMact a"
shows "open s' = open s"
using assms proof (cases a)
  case (COMact ca) then show ?thesis using assms by (cases ca) (auto simp: open_def com_defs)
qed auto

lemma validTrans_isCOMact_open:
assumes "validTrans trn"
and "isCOMact (actOf trn)"
shows "open (tgtOf trn) = open (srcOf trn)"
using assms step_isCOMact_open by (cases trn) auto



lemma list_all_isOVal_filter_isPValS:
"list_all isOVal vl ⟹ filter (Not o isPValS) vl = vl"
by (induct vl) auto

lemma list_all_Not_isOVal_OVal_True:
assumes "list_all (Not ∘ isOVal) ul"
and "ul @ vll = OVal True # vll'"
shows "ul = []"
using assms by (cases ul) auto

lemma list_all_filter_isOVal_isPVal_isPValS:
assumes "list_all (Not ∘ isOVal) ul"
and "filter isPValS ul = []" and "filter isPVal ul = []"
shows "ul = []"
using assms value.exhaust_disc by (induct ul) auto

lemma filter_list_all_isPValS_isOVal:
assumes "list_all (Not ∘ isOVal) ul" and "filter isPVal ul = []"
shows "list_all isPValS ul"
using assms value.exhaust_disc by (induct ul) auto

lemma filter_list_all_isPVal_isOVal:
assumes "list_all (Not ∘ isOVal) ul" and "filter isPValS ul = []"
shows "list_all isPVal ul"
using assms value.exhaust_disc by (induct ul) auto

lemma list_all_isPValS_Not_isOVal_filter:
assumes "list_all isPValS ul" shows "list_all (Not ∘ isOVal) ul ∧ filter isPVal ul = []"
using assms value.exhaust_disc by (induct ul) auto

lemma filter_isTValS_Nil:
"filter isPValS vl = [] ⟷
 list_all (λ v. isPVal v ∨ isOVal v) vl"
proof(induct vl)
  case (Cons v vl)
  thus ?case by (cases v) auto
qed auto

(*   ******  *)
fun φ :: "(state,act,out) trans ⇒ bool" where
"φ (Trans _ (Uact (uPost uid p pid pst)) ou _) = (pid = PID ∧ ou = outOK)"
|
"φ (Trans _ (COMact (comSendPost uid p aid pid)) ou _) = (pid = PID ∧ ou ≠ outErr)"
(* Added during strengthening: saying ≠ outErr is simpler than actually describing the output, which essentially
   takes some parameters from the post and some values from the state. *)
|
"φ (Trans s _ _ s') = (open s ≠ open s')"

lemma φ_def2:
assumes "step s a = (ou,s')"
shows
"φ (Trans s a ou s') ⟷
 (∃uid p pst. a = Uact (uPost uid p PID pst) ∧ ou = outOK) ∨
 (∃uid p aid. a = COMact (comSendPost uid p aid PID) ∧ ou ≠ outErr) ∨
  open s ≠ open s'"
using assms by (cases "Trans s a ou s'" rule: φ.cases) (auto simp: all_defs open_def)

lemma uTextPost_out:
assumes 1: "step s a = (ou,s')" and a: "a = Uact (uPost uid p PID pst)" and 2: "ou = outOK"
shows "uid = owner s PID ∧ p = pass s uid"
using 1 2 unfolding a by (auto simp: u_defs)

lemma comSendPost_out:
assumes 1: "step s a = (ou,s')" and a: "a = COMact (comSendPost uid p aid PID)"
  and 2: "ou ≠ outErr"
shows "ou = O_sendPost (aid, clientPass s aid, PID, post s PID, owner s PID, vis s PID)
       ∧ uid = admin s ∧ p = pass s (admin s)"
using 1 2 unfolding a by (auto simp: com_defs)

lemma step_open_isCOMact:
assumes "step s a = (ou,s')"
and "open s ≠ open s'"
shows "¬ isCOMact a ∧ ¬ (∃ ua. isuPost ua ∧ a = Uact ua)"
  using assms unfolding open_def
  apply(cases a)
  subgoal by (auto simp: all_defs)
  subgoal by (auto simp: all_defs)
  subgoal by (auto simp: all_defs)
  subgoal for x4 by (cases x4) (auto simp: all_defs)
  subgoal by (auto simp: all_defs)
  subgoal by (auto simp: all_defs)
  subgoal for x7 by (cases x7) (auto simp: all_defs)
  done

lemma φ_def3:
assumes "step s a = (ou,s')"
shows
"φ (Trans s a ou s') ⟷
 (∃pst. a = Uact (uPost (owner s PID) (pass s (owner s PID)) PID pst) ∧ ou = outOK)
 ∨
 (∃aid. a = COMact (comSendPost (admin s) (pass s (admin s)) aid PID) ∧
        ou = O_sendPost (aid, clientPass s aid, PID, post s PID, owner s PID, vis s PID))
 ∨
 open s ≠ open s' ∧ ¬ isCOMact a ∧ ¬ (∃ ua. isuPost ua ∧ a = Uact ua)"
unfolding φ_def2[OF assms]
using comSendPost_out[OF assms] uTextPost_out[OF assms]
step_open_isCOMact[OF assms]
by blast

fun f :: "(state,act,out) trans ⇒ value" where
"f (Trans s (Uact (uPost uid p pid pst)) _ s') =
 (if pid = PID then PVal pst else OVal (open s'))"  (* else undefined  *)
|
"f (Trans s (COMact (comSendPost uid p aid pid)) (O_sendPost (_, _, _, pst, _)) s') =
 (if pid = PID then PValS aid pst else OVal (open s'))" (* else undefined  *)
|
"f (Trans s _ _ s') = OVal (open s')"

lemma f_open_OVal:
assumes "step s a = (ou,s')"
and "open s ≠ open s' ∧ ¬ isCOMact a ∧ ¬ (∃ ua. isuPost ua ∧ a = Uact ua)"
shows "f (Trans s a ou s') = OVal (open s')"
using assms by (cases "Trans s a ou s'" rule: f.cases) auto

lemma f_eq_PVal:
assumes "step s a = (ou,s')" and "φ (Trans s a ou s')"
and "f (Trans s a ou s') = PVal pst"
shows "a = Uact (uPost (owner s PID) (pass s (owner s PID)) PID pst)"
using assms by (cases "Trans s a ou s'" rule: f.cases) (auto simp: u_defs com_defs)

lemma f_eq_PValS:
assumes "step s a = (ou,s')" and "φ (Trans s a ou s')"
and "f (Trans s a ou s') = PValS aid pst"
shows "a = COMact (comSendPost (admin s) (pass s (admin s)) aid PID)"
using assms by (cases "Trans s a ou s'" rule: f.cases) (auto simp: com_defs)

lemma f_eq_OVal:
assumes "step s a = (ou,s')" and "φ (Trans s a ou s')"
and "f (Trans s a ou s') = OVal b"
shows "open s' ≠ open s"
using assms by (auto simp: φ_def2 com_defs)

lemma uPost_comSendPost_open_eq:
assumes step: "step s a = (ou, s')"
and a: "a = Uact (uPost uid p pid pst) ∨ a = COMact (comSendPost uid p aid pid)"
shows "open s' = open s"
using assms a unfolding open_def
by (cases a) (auto simp: u_defs com_defs)

lemma step_open_φ_f_PVal_γ:
assumes s: "reach s"
and step: "step s a = (ou, s')"
and PID: "PID ∈ set (postIDs s)"
and op: "¬ open s" and fi: "φ (Trans s a ou s')" and f: "f (Trans s a ou s') = PVal pst"
shows "¬ γ (Trans s a ou s')"
proof-
  have a: "a = Uact (uPost (owner s PID) (pass s (owner s PID)) PID pst)"
  using f_eq_PVal[OF step fi f] .
  have ou: "ou = outOK" using fi op unfolding a φ_def2[OF step] by auto
  have "owner s PID ∈∈ userIDs s" using s by (simp add: PID reach_owner_userIDs)
  hence "owner s PID ∉ UIDs" using op PID unfolding open_def by auto
  thus ?thesis unfolding a by simp
qed

lemma Uact_uPaperC_step_eqButPID:
assumes a: "a = Uact (uPost uid p PID pst)"
and "step s a = (ou,s')"
shows "eqButPID s s'"
using assms unfolding eqButPID_def eeqButPID_def eeqButPID_F_def
by (auto simp: all_defs split: if_splits)

lemma eqButPID_step_φ_imp:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and φ: "φ (Trans s a ou s')"
shows "φ (Trans s1 a ou1 s1')"
proof-
  have s's1': "eqButPID s' s1'"
  using eqButPID_step local.step ss1 step1 by blast
  show ?thesis using step step1 φ eqButPID_open[OF ss1] eqButPID_open[OF s's1']
  using eqButPID_stateSelectors[OF ss1]
  unfolding φ_def2[OF step] φ_def2[OF step1]
  by (auto simp: all_defs)
qed

lemma eqButPID_step_φ:
assumes s's1': "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
shows "φ (Trans s a ou s') = φ (Trans s1 a ou1 s1')"
by (metis eqButPID_step_φ_imp eqButPID_sym assms)


end



end
>

Theory DYNAMIC_Post_ISSUER

theory DYNAMIC_Post_ISSUER
  imports
    "Post_Observation_Setup_ISSUER"
    DYNAMIC_Post_Value_Setup_ISSUER
    "Bounded_Deducibility_Security.Compositional_Reasoning"
begin


subsubsection ‹Issuer declassification bound›

text ‹\label{sec:dynamic-post-issuer}
We verify that a group of users of some node ‹i›,
allowed to take normal actions to the system and observe their outputs
\emph{and additionally allowed to observe communication},
can learn nothing about the updates to a post located at node ‹i›
and the sends of that post to other nodes beyond:

(1) the updates that occur during the times when one of the following holds,
and the ∗‹last› update ∗‹before› one of the following holds
(because, for example, observers can see the current version of the post when it is made public):
\begin{itemize}
\item either a user in the group is the post's owner or the administrator
\item or a user in the group is a friend of the owner
\item or the group has at least one registered user and the post is marked "public"
\end{itemize}

(2) the presence of the sends (i.e., the number of the sending actions)

(3) the public knowledge that what is being sent is always the last version (modeled as
the correlation predicate)

See \cite[Appendix C]{cosmedis-SandP2017} for more details. This is the dynamic-trigger
(i.e., trigger-incorporating inductive bound) version of the property proved in
Section~\ref{sec:post-issuer}.
For a discussion of this ``while-or-last-before'' style of formalizing bounds,
see @{cite ‹Section 3.4› "cosmed-jar2018"} about the the corresponding property of CoSMed.
›

context Post
begin

fun T :: "(state,act,out) trans ⇒ bool" where "T _ = False"

inductive BC :: "value list ⇒ value list ⇒ bool"
and BO :: "value list ⇒ value list ⇒ bool"
where
 BC_PVal[simp,intro!]:
  "list_all (Not o isOVal) ul ⟹ list_all (Not o isOVal) ul1 ⟹
   map tgtAPI (filter isPValS ul) = map tgtAPI (filter isPValS ul1) ⟹
   (ul = [] ⟶ ul1 = [])
   ⟹ BC ul ul1"
|BC_BO[intro]:
  "BO vl vl1 ⟹
   list_all (Not o isOVal) ul ⟹ list_all (Not o isOVal) ul1 ⟹
   map tgtAPI (filter isPValS ul) = map tgtAPI (filter isPValS ul1) ⟹
   (ul = [] ⟷ ul1 = []) ⟹
   (ul ≠ [] ⟹ isPVal (last ul) ∧ last ul = last ul1) ⟹
   list_all isPValS sul
   ⟹
   BC (ul  @ sul @ OVal True # vl)
      (ul1 @ sul @ OVal True # vl1)"
(*  *)
|BO_PVal[simp,intro!]:
  "list_all (Not o isOVal) ul ⟹ BO ul ul"
|BO_BC[intro]:
  "BC vl vl1 ⟹
   list_all (Not o isOVal) ul
   ⟹
   BO (ul @ OVal False # vl) (ul @ OVal False # vl1)"

lemma list_all_filter_Not_isOVal:
assumes "list_all (Not ∘ isOVal) ul"
and "filter isPValS ul = []" and "filter isPVal ul = []"
shows "ul = []"
using assms value.exhaust_disc by (induct ul) auto

lemma BC_not_Nil: "BC vl vl1 ⟹ vl = [] ⟹ vl1 = []"
by(auto elim: BC.cases)

lemma BC_OVal_True:
assumes "BC (OVal True # vl') vl1"
shows "∃ vl1'. BO vl' vl1' ∧ vl1 = OVal True # vl1'"
proof-
  define vl where vl: "vl ≡ OVal True # vl'"
  have "BC vl vl1" using assms unfolding vl by auto
  thus ?thesis proof cases
    case (BC_BO vll vll1 ul ul1 sul)
    hence ul: "ul = []" unfolding vl apply simp
    by (metis (no_types) Post.value.disc(9) append_eq_Cons_conv
         list.map(2) list.pred_inject(2) list_all_map)
    have sul: "sul = []" using BC_BO unfolding vl ul apply simp
    by (metis Post.value.disc(6) append_eq_Cons_conv list.pred_inject(2))
    show ?thesis
    apply - apply(rule exI[of _ "vll1"])
    using BC_BO using list_all_filter_Not_isOVal[of ul1]
    unfolding ul sul vl by auto
  qed(unfold vl, auto)
qed

(* Correlation is defined to mean: always send what was last uploaded, or emptyPost
if nothing had been uploaded. This needs the auxiliary notion of "correlation from" *)
fun corrFrom :: "post ⇒ value list ⇒ bool" where
 "corrFrom pst [] = True"
|"corrFrom pst (PVal pstt # vl) = corrFrom pstt vl"
|"corrFrom pst (PValS aid pstt # vl) = (pst = pstt ∧ corrFrom pst vl)"
|"corrFrom pst (OVal b # vl) = (corrFrom pst vl)"


abbreviation corr :: "value list ⇒ bool" where "corr ≡ corrFrom emptyPost"

definition B where
"B vl vl1 ≡ BC vl vl1 ∧ corr vl1"

(* lemma vl_Nil_filter_not:
assumes "filter (%v. isPVal v ∨ isOVal v) Vl = [] ∧ filter (Not o isPVal) Vl = []"
shows "Vl = []"
using assms by (induct Vl) auto *)

lemma B_not_Nil:
assumes B: "B vl vl1" and vl: "vl = []"
shows "vl1 = []"
using B Post.BC_not_Nil Post.B_def vl by blast


sublocale BD_Security_IO where
istate = istate and step = step and
φ = φ and f = f and γ = γ and g = g and T = T and B = B
done

subsubsection ‹Issuer unwinding proof›

lemma reach_PublicV_imples_FriendV[simp]:
assumes "reach s"
and "vis s pid ≠ PublicV"
shows "vis s pid = FriendV"
using assms reach_vis by auto


(* major *) lemma eqButPID_step_γ_out:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and op: "¬ open s"
and sT: "reachNT s" and s1: "reach s1"
and γ: "γ (Trans s a ou s')"
shows "(∃ uid p aid pid. a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
       ou = ou1"
proof-
  note [simp] = all_defs
                open_def
  note s = reachNT_reach[OF sT]
  note willUse =
    step step1 γ
    not_open_eqButPID[OF op ss1]
    reach_vis[OF s]
    eqButPID_stateSelectors[OF ss1] (* eqButPID_postSelectors[OF ss1]  *)
    eqButPID_actions[OF ss1]
    eqButPID_update[OF ss1] (* eqButPID_setTextPost[OF ss1] *) eqButPID_not_PID[OF ss1]
  (* added to cope with extra leak towards the admin, when moving from CoSMed to CosMeDis: *)
    (* eqButPID_eqButT[OF ss1] *) eqButPID_eqButF[OF ss1]
    eqButPID_setShared[OF ss1] eqButPID_updateShared[OF ss1]
    eeqButPID_F_not_PID eqButPID_not_PID_sharedWith
    eqButPID_insert2[OF ss1]
  show ?thesis
  proof (cases a)
    case (Sact x1)
    with willUse show ?thesis by (cases x1) auto
  next
    case (Cact x2)
    with willUse show ?thesis by (cases x2) auto
  next
    case (Dact x3)
    with willUse show ?thesis by (cases x3) auto
  next
    case (Uact x4)
    with willUse show ?thesis by (cases x4) auto
  next
    case (Ract x5)
    with willUse show ?thesis
    proof (cases x5)
      case (rPost uid p pid)
      with Ract willUse show ?thesis by (cases "pid = PID") auto
    qed auto
  next
    case (Lact x6)
    with willUse show ?thesis
    proof (cases x6)
      case (lClientsPost uid p pid)
      with Lact willUse show ?thesis by (cases "pid = PID") auto
    qed auto
  next
    case (COMact x7)
    with willUse show ?thesis by (cases x7) auto
  qed
qed

(* major *) lemma eqButPID_step_eq:
assumes ss1: "eqButPID s s1"
and a: "a = Uact (uPost uid p PID pst)" "ou = outOK"
and step: "step s a = (ou, s')" and step1: "step s1 a = (ou', s1')"
shows "s' = s1'"
using ss1 step step1
using eqButPID_stateSelectors[OF ss1]
eqButPID_update[OF ss1] (* eqButPID_setTextPost[OF ss1] *) eqButPID_setShared[OF ss1]
unfolding a by (auto simp: u_defs)


definition Δ0 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ0 s vl s1 vl1 ≡
 ¬ PID ∈∈ postIDs s ∧
 s = s1 ∧ BC vl vl1 ∧
 corr vl1"

definition Δ1 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ1 s vl s1 vl1 ≡
 PID ∈∈ postIDs s ∧
 list_all (Not o isOVal) vl ∧ list_all (Not o isOVal) vl1 ∧
 map tgtAPI (filter isPValS vl) = map tgtAPI (filter isPValS vl1) ∧
 (vl = [] ⟶ vl1 = []) ∧
 eqButPID s s1 ∧ ¬ open s ∧
 corrFrom (post s1 PID) vl1"

definition Δ11 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ11 s vl s1 vl1 ≡
 PID ∈∈ postIDs s ∧
 vl = [] ∧ list_all isPVal vl1 ∧
 eqButPID s s1 ∧ ¬ open s ∧
 corrFrom (post s1 PID) vl1"

definition Δ2 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ2 s vl s1 vl1 ≡
 PID ∈∈ postIDs s ∧
 list_all (Not o isOVal) vl ∧
 vl = vl1 ∧
 s = s1 ∧ open s ∧
 corrFrom (post s1 PID) vl1"

definition Δ31 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ31 s vl s1 vl1 ≡
 PID ∈∈ postIDs s ∧
 (∃ ul ul1 sul vll vll1.
    BO vll vll1 ∧
    list_all (Not o isOVal) ul ∧ list_all (Not o isOVal) ul1 ∧
    map tgtAPI (filter isPValS ul) = map tgtAPI (filter isPValS ul1) ∧
    ul ≠ [] ∧ ul1 ≠ [] ∧
    isPVal (last ul) ∧ last ul = last ul1 ∧
    list_all isPValS sul ∧
    vl = ul @ sul @ OVal True # vll ∧ vl1 = ul1 @ sul @ OVal True # vll1) ∧
 eqButPID s s1 ∧ ¬ open s ∧
 corrFrom (post s1 PID) vl1"

definition Δ32 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ32 s vl s1 vl1 ≡
 PID ∈∈ postIDs s ∧
 (∃ sul vll vll1.
    BO vll vll1 ∧
    list_all isPValS sul ∧
    vl = sul @ OVal True # vll ∧ vl1 = sul @ OVal True # vll1) ∧
 s = s1 ∧ ¬ open s ∧
 corrFrom (post s1 PID) vl1"

definition Δ4 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ4 s vl s1 vl1 ≡
 PID ∈∈ postIDs s ∧
 (∃ ul vll vll1.
    BC vll vll1 ∧
    list_all (Not o isOVal) ul ∧
    vl = ul @ OVal False # vll ∧ vl1 = ul @ OVal False # vll1) ∧
 s = s1 ∧ open s ∧
 corrFrom (post s1 PID) vl1"

lemma istate_Δ0:
assumes B: "B vl vl1"
shows "Δ0 istate vl istate vl1"
using assms unfolding Δ0_def istate_def B_def by auto
(* by (auto simp: list_all_isOVal_filter_isPValS)
(auto intro!: exI[of _ "[]"]) *)

lemma list_all_filter[simp]:
assumes "list_all PP xs"
shows "filter PP xs = xs"
using assms by (induct xs) auto

lemma unwind_cont_Δ0: "unwind_cont Δ0 {Δ0,Δ1,Δ2,Δ31,Δ32,Δ4}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ0 s vl s1 vl1 ∨
                           Δ1 s vl s1 vl1 ∨ Δ2 s vl s1 vl1 ∨
                           Δ31 s vl s1 vl1 ∨ Δ32 s vl s1 vl1 ∨ Δ4 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ0 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s" and BC: "BC vl vl1" and PID: "¬ PID ∈∈ postIDs s"
  and cor1: "corr vl1" using reachNT_reach unfolding Δ0_def by auto
  have vis: "vis s PID = FriendV" using reach_not_postIDs_friendV[OF rs PID] .
  have pPID: "post s1 PID = emptyPost" by (simp add: PID reach_not_postIDs_emptyPost rs ss1)
  have vlvl1: "vl = [] ⟹ vl1 = []" using BC_not_Nil BC by auto
  have op: "¬ open s" using PID unfolding open_def by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      hence pPID': "post s' PID = emptyPost"
        using step pPID ss1 PID
        apply(cases a)
        subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
        subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
        subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
        subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
        subgoal by (fastforce simp: d_defs)
        subgoal by (fastforce simp: d_defs)
        subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
        done
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof-
        have ?match
        proof(cases "∃ uid p. a = Cact (cPost uid p PID) ∧ ou = outOK")
          case True
          then obtain uid p where a: "a = Cact (cPost uid p PID)" and ou: "ou = outOK" by auto
          have PID': "PID ∈∈ postIDs s'"
          using step PID unfolding a ou by (auto simp: c_defs)
          show ?thesis proof(cases
             "∃ uid' ∈ UIDs. uid' ∈∈ userIDs s ∧
                             (uid' = admin s ∨ uid' = uid ∨ uid' ∈∈ friendIDs s uid)")
            case True note uid = True
            have op': "open s'" using uid using step PID' unfolding a ou by (auto simp: c_defs open_def)
            have φ: "φ ?trn" using op op' unfolding φ_def2[OF step] by simp
            then obtain v where vl: "vl = v # vl'" and f: "f ?trn = v"
            using c unfolding consume_def φ_def2 by(cases vl) auto
            have v: "v = OVal True" using f op op' unfolding a by simp
            then obtain ul1 vl1' where BO': "BO vl' vl1'" and vl1: "vl1 = ul1 @ OVal True # vl1'"
            and ul1: "list_all (Not ∘ isOVal) ul1"
            using BC_OVal_True[OF BC[unfolded vl v]] by auto
            have ul1: "ul1 = []"
              using BC BC_OVal_True list_all_Not_isOVal_OVal_True ul1 v vl vl1 by blast
            hence vl1: "vl1 = OVal True # vl1'" using vl1 by simp
            show ?thesis proof
              show "validTrans ?trn1" unfolding ss1 using step by simp
            next
              show "consume ?trn1 vl1 vl1'" using φ f unfolding vl1 v consume_def ss1 by simp
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              show "?Δ s' vl' s' vl1'" using BO' proof(cases rule: BO.cases)
                case (BO_PVal)
                hence "Δ2 s' vl' s' vl1'" using PID' op' cor1 unfolding Δ2_def vl1 pPID' by auto
                thus ?thesis by simp
              next
                case (BO_BC vll vll1 textl)
                hence "Δ4 s' vl' s' vl1'" using PID' op' cor1 unfolding Δ4_def vl1 pPID' by auto
                thus ?thesis by simp
              qed
            qed
          next
            case False note uid = False
            have op': "¬ open s'" using step op uid vis unfolding open_def a by (auto simp: c_defs)
            have φ: "¬ φ ?trn" using op op' a unfolding φ_def2[OF step] by auto
            hence vl': "vl' = vl" using c unfolding consume_def by simp
            show ?thesis proof
              show "validTrans ?trn1" unfolding ss1 using step by simp
            next
              show "consume ?trn1 vl1 vl1" using φ unfolding consume_def ss1 by auto
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              show "?Δ s' vl' s' vl1" using BC proof(cases rule: BC.cases)
                case (BC_PVal)
                hence "Δ1 s' vl' s' vl1" using PID' op' cor1 unfolding Δ1_def vl' pPID' by auto
                thus ?thesis by simp
              next
                case (BC_BO vll vll1 ul ul1 sul)
                show ?thesis
                proof(cases "ul ≠ [] ∧ ul1 ≠ []")
                  case True
                  hence "Δ31 s' vl' s' vl1" using BC_BO PID' op' cor1
                  unfolding Δ31_def vl' pPID' apply auto
                  apply (rule exI[of _ "ul"]) apply (rule exI[of _ "ul1"])
                  apply (rule exI[of _ "sul"])
                  apply (rule exI[of _ "vll"]) apply (rule exI[of _ "vll1"])
                  by auto
                  thus ?thesis by simp
                next
                  case False
                  hence 0: "ul = [] ∧ ul1 = []" using BC_BO by simp
                  hence 1: "list_all isPValS ul ∧ list_all isPValS ul1"
                  using ‹list_all (Not ∘ isOVal) ul› ‹list_all (Not ∘ isOVal) ul1›
                  using filter_list_all_isPValS_isOVal by auto
                  (* have "map tgtAPI ul = map tgtAPI ul1" using 1BC_BO by auto *)
                  have "Δ32 s' vl' s' vl1" using BC_BO PID' op' cor1 0 1
                  unfolding Δ32_def vl' pPID' apply simp
                  apply(rule exI[of _ "sul"])
                  apply(rule exI[of _ vll]) apply(rule exI[of _ vll1])
                  by auto
                  thus ?thesis by simp
                qed
              qed
            qed
          qed
        next
          case False note a = False
          have op': "¬ open s'"
            using a step PID op unfolding open_def
            apply(cases a)
            subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
            subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
            subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
            subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
            subgoal by (fastforce simp: u_defs)
            subgoal by (fastforce simp: u_defs)
            subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
            done
          have φ: "¬ φ ?trn" using PID step op op' unfolding φ_def2[OF step]
          by (auto simp: u_defs com_defs)
          hence vl': "vl' = vl" using c unfolding consume_def by simp
          have PID': "¬ PID ∈∈ postIDs s'"
            using step PID a
            apply(cases a)
            subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
            subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
            subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
            subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
            subgoal by (fastforce simp: u_defs)
            subgoal by (fastforce simp: u_defs)
            subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
            done
          show ?thesis proof
            show "validTrans ?trn1" unfolding ss1 using step by simp
          next
            show "consume ?trn1 vl1 vl1" using φ unfolding consume_def ss1 by auto
          next
            show "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            have "Δ0 s' vl' s' vl1" using a BC PID' cor1 unfolding Δ0_def vl' by simp
            thus "?Δ s' vl' s' vl1" by simp
          qed
        qed
        thus ?thesis by simp
      qed
    qed
  thus ?thesis using vlvl1 by simp
  qed
qed

lemma unwind_cont_Δ1: "unwind_cont Δ1 {Δ1,Δ11}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ1 s vl s1 vl1 ∨ Δ11 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ1 s vl s1 vl1"
  then obtain
  lvl: "list_all (Not ∘ isOVal) vl" and lvl1: "list_all (Not ∘ isOVal) vl1"
  and map: "map tgtAPI (filter isPValS vl) = map tgtAPI (filter isPValS vl1)"
  and rs: "reach s" and ss1: "eqButPID s s1" and op: "¬ open s" and PID: "PID ∈∈ postIDs s"
  and vlvl1: "vl = [] ⟹ vl1 = []" and cor1: "corrFrom (post s1 PID) vl1"
  using reachNT_reach unfolding Δ1_def by auto
  have PID1: "PID ∈∈ postIDs s1" using eqButPID_stateSelectors[OF ss1] PID by auto
  have own: "owner s PID ∈ set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  hence own1: "owner s1 PID ∈ set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  have adm: "admin s ∈ set (userIDs s)" using reach_admin_userIDs[OF rs own] .
  hence adm1: "admin s1 ∈ set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  have op1: "¬ open s1" using op ss1 eqButPID_open by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof(cases vl1)
    case (Cons v1 vll1) note vl1 = Cons
    show ?thesis proof(cases v1)
      case (PVal pst1) note v1 = PVal
      define uid where uid: "uid ≡ owner s PID"  define p where p: "p ≡ pass s uid"
      define a1 where a1: "a1 ≡ Uact (uPost uid p PID pst1)"
      have uid1: "uid = owner s1 PID" and p1: "p = pass s1 uid" unfolding uid p
      using eqButPID_stateSelectors[OF ss1] by auto
      obtain ou1 s1' where step1: "step s1 a1 = (ou1, s1')" by(cases "step s1 a1") auto
      have ou1: "ou1 = outOK" using step1 PID1 own1 unfolding a1 uid1 p1 by (auto simp: u_defs)
      have op1': "¬ open s1'" using step1 op1 unfolding a1 ou1 open_def by (auto simp: u_defs)
      have uid: "uid ∉ UIDs" unfolding uid using op PID own unfolding open_def by auto
      have pPID1': "post s1' PID = pst1" using step1 unfolding a1 ou1 by (auto simp: u_defs)
      let ?trn1 = "Trans s1 a1 ou1 s1'"
      have ?iact proof
        show "step s1 a1 = (ou1, s1')" using step1 .
      next
        show φ: "φ ?trn1" unfolding φ_def2[OF step1] a1 ou1 by simp
        show "consume ?trn1 vl1 vll1"
        using φ unfolding vl1 consume_def v1 a1 by auto
      next
        show "¬ γ ?trn1" using uid unfolding a1 by auto
      next
        have "eqButPID s1 s1'" using Uact_uPaperC_step_eqButPID[OF _ step1] a1 by auto
        hence ss1': "eqButPID s s1'" using eqButPID_trans ss1 by blast
        show "?Δ s vl s1' vll1" using PID op ss1' lvl lvl1 map vlvl1 cor1
        unfolding Δ1_def vl1 v1 pPID1' by auto
      qed
      thus ?thesis by simp
    next
      case (PValS aid1 pst1) note v1 = PValS
      have pPID1: "post s1 PID = pst1" using cor1 unfolding vl1 v1 by auto
      then obtain v vll where vl: "vl = v # vll"
      using map unfolding vl1 v1 by (cases vl) auto
      have ?react proof
        fix a :: act and ou :: out and s' :: state and vl'
        let ?trn = "Trans s a ou s'"
        assume step: "step s a = (ou, s')" and c: "consume ?trn vl vl'"
        have PID': "PID ∈∈ postIDs s'" using reach_postIDs_persist[OF PID step] .
        obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
        let ?trn1 = "Trans s1 a ou1 s1'"
        show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'"
            (is "?match ∨ ?ignore")
        proof(cases "φ ?trn")
          case True note φ = True
          then obtain f: "f ?trn = v" and vl': "vl' = vll"
          using c unfolding vl consume_def φ_def2 by auto
          show ?thesis
          proof(cases v)
            case (PVal pst) note v = PVal
            have vll: "vll ≠ []" using map unfolding vl1 v1 vl v by auto
            define uid where uid: "uid ≡ owner s PID"  define p where p: "p ≡ pass s uid"
            have a: "a = Uact (uPost uid p PID pst)"
            using f_eq_PVal[OF step φ f[unfolded v]] unfolding uid p .
            have "eqButPID s s'" using Uact_uPaperC_step_eqButPID[OF a step] by auto
            hence s's1: "eqButPID s' s1" using eqButPID_sym eqButPID_trans ss1 by blast
            have op': "¬ open s'" using uPost_comSendPost_open_eq[OF step] a op by auto
            have ?ignore proof
              show γ: "¬ γ ?trn" using step_open_φ_f_PVal_γ[OF rs step PID op φ f[unfolded v]] .
              show "?Δ s' vl' s1 vl1"
              using lvl1 lvl PID' map s's1 op' vll cor1 unfolding Δ1_def vl1 vl vl' v
              by auto
            qed
            thus ?thesis by simp
          next
            case (PValS aid pst) note v = PValS
            define uid where uid: "uid ≡ admin s" define p where p: "p ≡ pass s uid"
            have a: "a = COMact (comSendPost (admin s) p aid PID)"
            using f_eq_PValS[OF step φ f[unfolded v]] unfolding uid p .
            have op': "¬ open s'" using uPost_comSendPost_open_eq[OF step] a op by auto
            have aid1: "aid1 = aid" using map unfolding vl1 v1 vl v by simp
            have uid1: "uid = admin s1" and p1: "p = pass s1 uid" unfolding uid p
            using eqButPID_stateSelectors[OF ss1] by auto
            obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
            have pPID1': "post s1' PID = pst1" using pPID1 step1 unfolding a
            by (auto simp: com_defs)
            have uid: "uid ∉ UIDs" unfolding uid using op PID adm unfolding open_def by auto
            have op1': "¬ open s1'" using step1 op1 unfolding a open_def
            by (auto simp: u_defs com_defs)
            let ?trn1 = "Trans s1 a ou1 s1'"
            have φ1: "φ ?trn1" using eqButPID_step_φ_imp[OF ss1 step step1 φ] .
            have ou1: "ou1 =
                O_sendPost (aid, clientPass s1 aid, PID, post s1 PID, owner s1 PID, vis s1 PID)"
              using φ1 step1 adm1 PID1 unfolding a by (cases ou1, auto simp: com_defs)
            have f1: "f ?trn1 = v1" using φ1 unfolding φ_def2[OF step1] v1 a ou1 aid1 pPID1 by auto
            have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
            have ?match proof
              show "validTrans ?trn1" using step1 by simp
            next
              show "consume ?trn1 vl1 vll1" using φ1 unfolding consume_def vl1 f1 by simp
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" note γ = this
              have ou: "(∃ uid p aid pid.
                       a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                                        ou = ou1"
              using eqButPID_step_γ_out[OF ss1 step step1 op rsT rs1 γ] .
              thus "g ?trn = g ?trn1" by (cases a) auto
            next
              show "?Δ s' vl' s1' vll1"
              proof(cases "vll = []")
                case True note vll = True
                hence "filter isPValS vll1 = []" using map lvl lvl1 unfolding vl vl1 v v1 by simp
                hence lvl1: "list_all isPVal vll1"
                using filter_list_all_isPVal_isOVal lvl1 unfolding vl1 v1 by auto
                hence "Δ11 s' vl' s1' vll1" using s's1' op1' op' PID' lvl lvl1 map cor1 pPID1 pPID1'
                unfolding Δ11_def vl vl' vl1 v v1 vll by auto
                thus ?thesis by auto
              next
                case False note vll = False
                hence "Δ1 s' vl' s1' vll1" using s's1' op1' op' PID' lvl lvl1 map cor1 pPID1 pPID1'
                unfolding Δ1_def vl vl' vl1 v v1 by auto
                thus ?thesis by auto
              qed
            qed
          thus ?thesis using vl by simp
        qed(insert lvl vl, auto)
      next
        case False note φ = False
        hence vl': "vl' = vl" using c unfolding consume_def by auto
        obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
        have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
        let ?trn1 = "Trans s1 a ou1 s1'"
        have φ1: "¬ φ ?trn1" using φ ss1 by (simp add: eqButPID_step_φ step step1)
        have pPID1': "post s1' PID = pst1" using PID1 pPID1 step1 φ1 (* unfolding φ_def2[OF step1] *)
          apply(cases a)
          subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
          subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
          subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
          subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
          subgoal by (fastforce simp: u_defs)
          subgoal by (fastforce simp: u_defs)
          subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
          done
        have op': "¬ open s'"
        using PID step φ op unfolding φ_def2[OF step] by auto
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def by simp
        next
          show "γ ?trn = γ ?trn1" unfolding ss1 by simp
        next
          assume "γ ?trn" note γ = this
          have ou: "(∃ uid p aid pid.
                   a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                   ou = ou1"
          using eqButPID_step_γ_out[OF ss1 step step1 op rsT rs1 γ] .
          thus "g ?trn = g ?trn1" by (cases a) auto
        next
          have "Δ1 s' vl' s1' vl1" using s's1' PID' pPID1 pPID1' lvl lvl1 map cor1 op'
          unfolding Δ1_def vl vl' by auto
          thus "?Δ s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vlvl1 by simp
  qed(insert lvl1 vl1, auto)
next
  case Nil note vl1 = Nil
  have ?react proof
    fix a :: act and ou :: out and s' :: state and vl'
    let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID ∈∈ postIDs s'" using reach_postIDs_persist[OF PID step] .
      obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
      let ?trn1 = "Trans s1 a ou1 s1'"
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof(cases "∃ uid p pstt. a = Uact (uPost uid p PID pstt) ∧ ou = outOK")
        case True then obtain uid p pstt where
        a: "a = Uact (uPost uid p PID pstt)" and ou: "ou = outOK" by auto
        hence φ: "φ ?trn" unfolding φ_def2[OF step] by auto
        then obtain v where vl: "vl = v # vl'" and f: "f ?trn = v"
        using c unfolding consume_def φ_def2 by (cases vl) auto
        obtain pst where v: "v = PVal pst" using map lvl unfolding vl vl1 by (cases v) auto
        have pstt: "pstt = pst" using f unfolding a v by auto
        have uid: "uid ∉ UIDs" using step op PID unfolding a ou open_def by (auto simp: u_defs)
        have "eqButPID s s'" using Uact_uPaperC_step_eqButPID[OF a step] by auto
        hence s's1: "eqButPID s' s1" using eqButPID_sym eqButPID_trans ss1 by blast
        have op': "¬ open s'" using step PID' op unfolding a ou open_def by (auto simp: u_defs)
        have ?ignore proof
          show "¬ γ ?trn" unfolding a using uid by auto
        next
          show "?Δ s' vl' s1 vl1" using PID' s's1 op' lvl map
          unfolding Δ1_def vl1 vl by auto
        qed
        thus ?thesis by simp
      next
        case False note a = False
        {assume φ: "φ ?trn"
         then obtain v vl' where vl: "vl = v # vl'" and f: "f ?trn = v"
         using c unfolding consume_def by (cases vl) auto
         obtain pst where v: "v = PVal pst" using map lvl unfolding vl vl1 by (cases v) auto
         have False using f f_eq_PVal[OF step φ, of pst] a φ v by auto
        }
        hence φ: "¬ φ ?trn" by auto
        have φ1: "¬ φ ?trn1" by (metis φ eqButPID_step_φ step ss1 step1)
        have op': "¬ open s'" using a op φ unfolding φ_def2[OF step] by auto
        have vl': "vl' = vl" using c φ unfolding consume_def by auto
        have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
        have op1': "¬ open s1'" using op' eqButPID_open[OF s's1'] by simp
        have "⋀ uid p pst. e_updatePost s1 uid p PID pst ⟷ e_updatePost s uid p PID pst"
        using eqButPID_stateSelectors[OF ss1] unfolding u_defs by auto
        hence ou1: "⋀ uid p pst. a = Uact (uPost uid p PID pst) ⟹ ou1 = ou"
        using step step1 by auto
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def by simp
        next
          show "γ ?trn = γ ?trn1" unfolding ss1 by simp
        next
          assume "γ ?trn" note γ = this
          have ou: "(∃ uid p aid pid.
                       a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                                        ou = ou1"
          using eqButPID_step_γ_out[OF ss1 step step1 op rsT rs1 γ] .
          thus "g ?trn = g ?trn1" by (cases a) auto
        next
          show "?Δ s' vl' s1' vl1" using s's1' op' PID' lvl map
          unfolding Δ1_def vl' vl1 by auto
        qed
      thus ?thesis by simp
      qed
    qed
    thus ?thesis using vlvl1 by simp
  qed
qed

lemma unwind_cont_Δ11: "unwind_cont Δ11 {Δ11}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ11 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ11 s vl s1 vl1"
  hence  vl: "vl = []" and lvl1: "list_all isPVal vl1"
  and rs: "reach s" and ss1: "eqButPID s s1" and op: "¬ open s" and PID: "PID ∈∈ postIDs s"
  and cor1: "corrFrom (post s1 PID) vl1"
  using reachNT_reach unfolding Δ11_def by auto
  have PID1: "PID ∈∈ postIDs s1" using eqButPID_stateSelectors[OF ss1] PID by auto
  have own: "owner s PID ∈ set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  hence own1: "owner s1 PID ∈ set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  have adm: "admin s ∈ set (userIDs s)" using reach_admin_userIDs[OF rs own] .
  hence adm1: "admin s1 ∈ set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  have op1: "¬ open s1" using op ss1 eqButPID_open by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof(cases vl1)
    case (Cons v1 vll1) note vl1 = Cons
    then obtain pst1 where v1: "v1 = PVal pst1" using lvl1 unfolding vl1 by (cases v1) auto
    define uid where uid: "uid ≡ owner s PID"  define p where p: "p ≡ pass s uid"
    define a1 where a1: "a1 ≡ Uact (uPost uid p PID pst1)"
    have uid1: "uid = owner s1 PID" and p1: "p = pass s1 uid" unfolding uid p
    using eqButPID_stateSelectors[OF ss1] by auto
    obtain ou1 s1' where step1: "step s1 a1 = (ou1, s1')" by(cases "step s1 a1") auto
    have ou1: "ou1 = outOK" using step1 PID1 own1 unfolding a1 uid1 p1 by (auto simp: u_defs)
    have op1': "¬ open s1'" using step1 op1 unfolding a1 ou1 open_def by (auto simp: u_defs)
    have uid: "uid ∉ UIDs" unfolding uid using op PID own unfolding open_def by auto
    have pPID1': "post s1' PID = pst1" using step1 unfolding a1 ou1 by (auto simp: u_defs)
    let ?trn1 = "Trans s1 a1 ou1 s1'"
    have ?iact proof
      show "step s1 a1 = (ou1, s1')" using step1 .
    next
      show φ: "φ ?trn1" unfolding φ_def2[OF step1] a1 ou1 by simp
      show "consume ?trn1 vl1 vll1"
      using φ unfolding vl1 consume_def v1 a1 by auto
    next
      show "¬ γ ?trn1" using uid unfolding a1 by auto
    next
      have "eqButPID s1 s1'" using Uact_uPaperC_step_eqButPID[OF _ step1] a1 by auto
      hence ss1': "eqButPID s s1'" using eqButPID_trans ss1 by blast
      show "?Δ s vl s1' vll1"
      using PID op ss1' lvl1 cor1 unfolding Δ11_def vl1 v1 vl pPID1' by auto
    qed
    thus ?thesis by simp
  next
    case Nil note vl1 = Nil
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and c: "consume ?trn vl vl'"
      have PID': "PID ∈∈ postIDs s'" using reach_postIDs_persist[OF PID step] .
      obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
      let ?trn1 = "Trans s1 a ou1 s1'"
      have φ: "¬ φ ?trn" using c unfolding consume_def vl by auto
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'"
          (is "?match ∨ ?ignore")
      proof-
        have vl': "vl' = vl" using c unfolding vl consume_def by auto
        obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
        have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
        let ?trn1 = "Trans s1 a ou1 s1'"
        have φ1: "¬ φ ?trn1" using φ ss1 by (simp add: eqButPID_step_φ step step1)
        have pPID1': "post s1' PID = post s1 PID" using PID1 step1 φ1
          apply(cases a)
          subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
          subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
          subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
          subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
          subgoal by fastforce
          subgoal by fastforce
          subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
          done
        have op': "¬ open s'" using PID step φ op unfolding φ_def2[OF step] by auto
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def by simp
        next
          show "γ ?trn = γ ?trn1" unfolding ss1 by simp
        next
          assume "γ ?trn" note γ = this
          have ou: "(∃ uid p aid pid.
                   a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                   ou = ou1"
          using eqButPID_step_γ_out[OF ss1 step step1 op rsT rs1 γ] .
          thus "g ?trn = g ?trn1" by (cases a) auto
        next
          have "?Δ s' vl' s1' vl1" using s's1' PID' pPID1' lvl1 cor1 op'
          unfolding Δ11_def vl vl' by auto
          thus "?Δ s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl1 by simp
  qed
qed

lemma unwind_cont_Δ31: "unwind_cont Δ31 {Δ31,Δ32}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ31 s vl s1 vl1 ∨ Δ32 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ31 s vl s1 vl1"
  then obtain ul ul1 sul vll vll1 where
  lul: "list_all (Not ∘ isOVal) ul" and lul1: "list_all (Not ∘ isOVal) ul1"
  and map: "map tgtAPI (filter isPValS ul) = map tgtAPI (filter isPValS ul1)"
  and rs: "reach s" and ss1: "eqButPID s s1" and op: "¬ open s" and PID: "PID ∈∈ postIDs s"
  and cor1: "corrFrom (post s1 PID) vl1"
  and ful: "ul ≠ []" and ful1: "ul1 ≠ []"
  and lastul: "isPVal (last ul)" and ulul1: "last ul = last ul1"
  and lsul: "list_all isPValS sul"
  and vl: "vl = ul @ sul @ OVal True # vll"
  and vl1: "vl1 = ul1 @ sul @ OVal True # vll1"
  and BO: "BO vll vll1"
  using reachNT_reach unfolding Δ31_def by auto
  have ulNE: "ul ≠ []" and ul1NE: "ul1 ≠ []" using ful ful1 by auto
  have PID1: "PID ∈∈ postIDs s1" using eqButPID_stateSelectors[OF ss1] PID by auto
  have own: "owner s PID ∈ set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  hence own1: "owner s1 PID ∈ set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  have adm: "admin s ∈ set (userIDs s)" using reach_admin_userIDs[OF rs own] .
  hence adm1: "admin s1 ∈ set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  have op1: "¬ open s1" using op ss1 eqButPID_open by auto
  obtain v1 ull1 where ul1: "ul1 = v1 # ull1" using ful1 by (cases ul1) auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof(cases v1)
    case (PVal pst1) note v1 = PVal
    show ?thesis proof(cases "list_ex isPVal ull1")
      case True note lull1 = True
      hence full1: "filter isPVal ull1 ≠ []" by (induct ull1) auto
      hence ull1NE: "ull1 ≠ []" by auto
      define uid where uid: "uid ≡ owner s PID"  define p where p: "p ≡ pass s uid"
      define a1 where a1: "a1 ≡ Uact (uPost uid p PID pst1)"
      have uid1: "uid = owner s1 PID" and p1: "p = pass s1 uid" unfolding uid p
      using eqButPID_stateSelectors[OF ss1] by auto
      obtain ou1 s1' where step1: "step s1 a1 = (ou1, s1')" by(cases "step s1 a1") auto
      have ou1: "ou1 = outOK" using step1 PID1 own1 unfolding a1 uid1 p1 by (auto simp: u_defs)
      have op1': "¬ open s1'" using step1 op1 unfolding a1 ou1 open_def by (auto simp: u_defs)
      have uid: "uid ∉ UIDs" unfolding uid using op PID own unfolding open_def by auto
      have pPID1': "post s1' PID = pst1" using step1 unfolding a1 ou1 by (auto simp: u_defs)
      let ?trn1 = "Trans s1 a1 ou1 s1'"
      let ?vl1' = "ull1 @ sul @ OVal True # vll1"
      have ?iact proof
        show "step s1 a1 = (ou1, s1')" using step1 .
      next
        show φ: "φ ?trn1" unfolding φ_def2[OF step1] a1 ou1 by simp
        show "consume ?trn1 vl1 ?vl1'"
        using φ unfolding vl1 ul1 consume_def v1 a1 by simp
      next
        show "¬ γ ?trn1" using uid unfolding a1 by auto
      next
        have "eqButPID s1 s1'" using Uact_uPaperC_step_eqButPID[OF _ step1] a1 by auto
        hence ss1': "eqButPID s s1'" using eqButPID_trans ss1 by blast
        have "Δ31 s vl s1' ?vl1'"
        using PID op ss1' lul lul1 map ulul1 cor1 BO ull1NE ful ful1 full1 lastul ulul1 lsul
        unfolding Δ31_def vl vl1 ul1 v1 pPID1' apply auto
        apply(rule exI[of _ "ul"]) apply(rule exI[of _ "ull1"]) apply(rule exI[of _ sul])
        apply(rule exI[of _ "vll"]) apply(rule exI[of _ "vll1"]) by auto
        thus "?Δ s vl s1' ?vl1'" by auto
      qed
      thus ?thesis by simp
    next
      case False note lull1 = False
      hence ull1: "ull1 = []" using lastul unfolding ulul1 ul1 v1 by simp(meson Bex_set last_in_set)
      hence ul1: "ul1 = [PVal pst1]" unfolding ul1 v1 by simp
      obtain ulll where ul_ulll: "ul = ulll ## PVal pst1" using lastul ulul1 ulNE unfolding ul1 ull1 v1
      by (cases ul rule: rev_cases) auto
      hence ulNE: "ul ≠ []" by simp
      (* then obtain v ul' where ul: "ul = v # ul'" by (cases ul) auto *)
      have "filter isPValS ulll = []" using map unfolding ul_ulll ul1 v1 ull1 by simp
      hence lull: "list_all isPVal ulll" using lul filter_list_all_isPVal_isOVal
      unfolding ul_ulll by auto
      have ?react  proof
        fix a :: act and ou :: out and s' :: state and vl'
        let ?trn = "Trans s a ou s'"
        assume step: "step s a = (ou, s')" and c: "consume ?trn vl vl'"
        have PID': "PID ∈∈ postIDs s'" using reach_postIDs_persist[OF PID step] .
        obtain ul' where cc: "consume ?trn ul ul'" and
        vl': "vl' = ul' @ sul @ OVal True # vll" using c ulNE unfolding consume_def vl
        by (cases "φ ?trn") auto
        obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
        let ?trn1 = "Trans s1 a ou1 s1'"
        show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'"
             (is "?match ∨ ?ignore")
        proof(cases ulll)
          case Nil
          hence ul: "ul = [PVal pst1]" unfolding ul_ulll by simp
          have ?match proof(cases "φ ?trn")
            case True note φ = True
            then obtain f: "f ?trn = PVal pst1" and ul': "ul' = []"
            using cc unfolding ul consume_def φ_def2 by auto
            define uid where uid: "uid ≡ owner s PID"  define p where p: "p ≡ pass s uid"
            have a: "a = Uact (uPost uid p PID pst1)"
            using f_eq_PVal[OF step φ f] unfolding uid p .
            have uid1: "uid = owner s1 PID" and p1: "p = pass s1 uid" unfolding uid p
            using eqButPID_stateSelectors[OF ss1] by auto
            obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
            let ?trn1 = "Trans s1 a ou1 s1'"
            have φ1: "φ ?trn1" using eqButPID_step_φ_imp[OF ss1 step step1 φ] .
            have ou1: "ou1 = outOK"
            using φ1 step1 PID1 unfolding a by (cases ou1, auto simp: com_defs)
            have pPID': "post s' PID = pst1" using step φ unfolding a by (auto simp: u_defs)
            have pPID1': "post s1' PID = pst1" using step1 φ1 unfolding a by (auto simp: u_defs)
            have uid: "uid ∉ UIDs" unfolding uid using op PID own unfolding open_def by auto
            have op1': "¬ open s1'" using step1 op1 unfolding a open_def
            by (auto simp: u_defs com_defs)
            have f1: "f ?trn1 = PVal pst1" using φ1 unfolding φ_def2[OF step1] v1 a ou1 by auto
            have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
            have op': "¬ open s'" using uPost_comSendPost_open_eq[OF step] a op by auto
            have ou: "ou = outOK" using φ op op' unfolding φ_def2[OF step] a by auto
            let ?vl' = "sul @ OVal True # vll"
            let ?vl1' = "sul @ OVal True # vll1"
            show ?thesis proof
              show "validTrans ?trn1" using step1 by simp
            next
              show "consume ?trn1 vl1 ?vl1'"
              using φ1 unfolding consume_def ul1 f1 vl1 by simp
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" note γ = this
              thus "g ?trn = g ?trn1" using ou ou1 by (cases a) auto
            next
              have s': "s' = s1'" using eqButPID_step_eq[OF ss1 a ou step step1] .
              have corr1: "corrFrom (post s1' PID) ?vl1'"
              using cor1 unfolding vl1 ul1 v1 pPID1' by auto
              have "Δ32 s' vl' s1' ?vl1'"
              using PID' op1 op' s's1' lul lul1 map ulul1 cor1 BO ful ful1 lastul ulul1 lsul corr1
              unfolding Δ32_def vl vl1 v1 vl' ul' ul ul1 s' apply simp
              apply(rule exI[of _ sul])
              apply(rule exI[of _ "vll"]) apply(rule exI[of _ "vll1"]) by auto
              thus "?Δ s' vl' s1' ?vl1'" by simp
            qed
          next
            case False note φ = False
            hence ul': "ul' = ul" using cc unfolding consume_def by auto
            obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
            have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
            let ?trn1 = "Trans s1 a ou1 s1'"
            have φ1: "¬ φ ?trn1" using φ ss1 by (simp add: eqButPID_step_φ step step1)
            have pPID1': "post s1' PID = post s1 PID" using PID1 step1 φ1
              apply(cases a)
              subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
              subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
              subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
              subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
              subgoal by fastforce
              subgoal by fastforce
              subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
              done
            have op': "¬ open s'" using PID step φ op unfolding φ_def2[OF step] by auto
            have ?match proof
              show "validTrans ?trn1" using step1 by simp
            next
              show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def by simp
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" note γ = this
              have ou: "(∃ uid p aid pid.
                 a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                 ou = ou1"
              using eqButPID_step_γ_out[OF ss1 step step1 op rsT rs1 γ] .
              thus "g ?trn = g ?trn1" by (cases a) auto
            next
              have "Δ31 s' vl' s1' vl1"
              using PID' pPID1' op' s's1' lul lul1 map ulul1 cor1
              BO ful ful1 lastul ulul1 lsul cor1
              unfolding Δ31_def vl vl1 v1 vl' ul' apply simp
              apply(rule exI[of _ "ul"]) apply(rule exI[of _ "ul1"]) apply(rule exI[of _ sul])
              apply(rule exI[of _ "vll"]) apply(rule exI[of _ "vll1"]) by auto
              thus "?Δ s' vl' s1' vl1" by simp
            qed
            thus ?thesis by simp
          qed
          thus ?thesis by simp
        next
          case (Cons v ullll) note ulll = Cons
          then obtain pst where v: "v = PVal pst" using lull ul_ulll ulll lul by (cases v) auto
          define ull where ull: "ull ≡ ullll ## PVal pst1"
          have ul: "ul = v # ull" unfolding ul_ulll ull ulll by simp
          show ?thesis proof(cases "φ ?trn")
            case True note φ = True
            then obtain f: "f ?trn = v" and ul': "ul' = ull"
            using cc unfolding ul consume_def φ_def2 by auto
            define uid where uid: "uid ≡ owner s PID"  define p where p: "p ≡ pass s uid"
            have a: "a = Uact (uPost uid p PID pst)"
            using f_eq_PVal[OF step φ f[unfolded v]] unfolding uid p .
            have "eqButPID s s'" using Uact_uPaperC_step_eqButPID[OF a step] by auto
            hence s's1: "eqButPID s' s1" using eqButPID_sym eqButPID_trans ss1 by blast
            have op': "¬ open s'" using uPost_comSendPost_open_eq[OF step] a op by auto
            have ?ignore proof
              show γ: "¬ γ ?trn" using step_open_φ_f_PVal_γ[OF rs step PID op φ f[unfolded v]] .
              have "Δ31 s' vl' s1 vl1"
              using PID' op' s's1 lul lul1 map ulul1 cor1 BO ful ful1 lastul ulul1 lsul ull
              unfolding Δ31_def vl vl1 v1 vl' ul' ul v apply simp
              apply(rule exI[of _ "ull"]) apply(rule exI[of _ "ul1"]) apply(rule exI[of _ sul])
              apply(rule exI[of _ "vll"]) apply(rule exI[of _ "vll1"]) by auto
              thus "?Δ s' vl' s1 vl1" by auto
            qed
            thus ?thesis by simp
          next
            case False note φ = False
            hence ul': "ul' = ul" using cc unfolding consume_def by auto
            obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
            have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
            let ?trn1 = "Trans s1 a ou1 s1'"
            have φ1: "¬ φ ?trn1" using φ ss1 by (simp add: eqButPID_step_φ step step1)
            have pPID1': "post s1' PID = post s1 PID" using PID1 step1 φ1
              apply(cases a)
              subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
              subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
              subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
              subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
              subgoal by fastforce
              subgoal by fastforce
              subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
              done
            have op': "¬ open s'" using PID step φ op unfolding φ_def2[OF step] by auto
            have ?match proof
              show "validTrans ?trn1" using step1 by simp
            next
              show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def by simp
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" note γ = this
              have ou: "(∃ uid p aid pid.
                 a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                 ou = ou1"
              using eqButPID_step_γ_out[OF ss1 step step1 op rsT rs1 γ] .
              thus "g ?trn = g ?trn1" by (cases a) auto
            next
              have "Δ31 s' vl' s1' vl1"
              using PID' pPID1' op' s's1' lul lul1 map ulul1 cor1
              BO ful ful1 lastul ulul1 lsul cor1
              unfolding Δ31_def vl vl1 v1 vl' ul' apply simp
              apply(rule exI[of _ "ul"]) apply(rule exI[of _ "ul1"]) apply(rule exI[of _ sul])
              apply(rule exI[of _ "vll"]) apply(rule exI[of _ "vll1"]) by auto
              thus "?Δ s' vl' s1' vl1" by simp
            qed
          thus ?thesis by simp
          qed
        qed
      qed
      thus ?thesis using vl by simp
    qed
  next
    case (PValS aid1 pst1) note v1 = PValS
    have pPID1: "post s1 PID = pst1" using cor1 unfolding vl1 ul1 v1 by auto
    then obtain v ull where ul: "ul = v # ull"
    using map unfolding ul1 v1 by (cases ul) auto
    let ?vl1' = "ull1 @ sul @ OVal True # vll1"
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and c: "consume ?trn vl vl'"
      have PID': "PID ∈∈ postIDs s'" using reach_postIDs_persist[OF PID step] .
      obtain ul' where cc: "consume ?trn ul ul'" and
      vl': "vl' = ul' @ sul @ OVal True # vll" using c ul unfolding consume_def vl
      by (cases "φ ?trn") auto
      obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
      let ?trn1 = "Trans s1 a ou1 s1'"
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'"
          (is "?match ∨ ?ignore")
      proof(cases "φ ?trn")
        case True note φ = True
        then obtain f: "f ?trn = v" and ul': "ul' = ull"
        using cc unfolding ul consume_def φ_def2 by auto
        show ?thesis
        proof(cases v)
          case (PVal pst) note v = PVal
          have full: "ull ≠ []" using map unfolding ul1 v1 ul v by auto
          define uid where uid: "uid ≡ owner s PID"  define p where p: "p ≡ pass s uid"
          have a: "a = Uact (uPost uid p PID pst)"
          using f_eq_PVal[OF step φ f[unfolded v]] unfolding uid p .
          have "eqButPID s s'" using Uact_uPaperC_step_eqButPID[OF a step] by auto
          hence s's1: "eqButPID s' s1" using eqButPID_sym eqButPID_trans ss1 by blast
          have op': "¬ open s'" using uPost_comSendPost_open_eq[OF step] a op by auto
          (* have "list_ex isPVal ull1" using lastul not_list_ex_filter
          using ful1 not_list_ex_filter ul1 v1 unfolding ulul1 by auto
          hence lull: "list_ex isPVal ull" using lastul ulul1 ull unfolding ul ul1 v v1
          by (metis filter_empty_conv last_ConsR last_in_set not_list_ex_filter)
          hence full: "filter isPVal ull ≠ []" by (induct ull) auto *)
          have ?ignore proof
            show γ: "¬ γ ?trn" using step_open_φ_f_PVal_γ[OF rs step PID op φ f[unfolded v]] .
            have "Δ31 s' vl' s1 vl1"
            using PID' op' s's1 lul lul1 map ulul1 cor1 BO ful ful1 lastul ulul1 lsul full
            unfolding Δ31_def vl vl1 v1 vl' ul' ul v apply simp
            apply(rule exI[of _ "ull"]) apply(rule exI[of _ "ul1"]) apply(rule exI[of _ sul])
            apply(rule exI[of _ "vll"]) apply(rule exI[of _ "vll1"]) by auto
            thus "?Δ s' vl' s1 vl1" by auto
          qed
          thus ?thesis by simp
        next
          case (PValS aid pst) note v = PValS
          define uid where uid: "uid ≡ admin s" define p where p: "p ≡ pass s uid"
          have a: "a = COMact (comSendPost (admin s) p aid PID)"
          using f_eq_PValS[OF step φ f[unfolded v]] unfolding uid p .
          have op': "¬ open s'" using uPost_comSendPost_open_eq[OF step] a op by auto
          have aid1: "aid1 = aid" using map unfolding ul1 v1 ul v by simp
          have uid1: "uid = admin s1" and p1: "p = pass s1 uid" unfolding uid p
          using eqButPID_stateSelectors[OF ss1] by auto
          obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
          have pPID1': "post s1' PID = pst1" using pPID1 step1 unfolding a
          by (auto simp: com_defs)
          have uid: "uid ∉ UIDs" unfolding uid using op PID adm unfolding open_def by auto
          have op1': "¬ open s1'" using step1 op1 unfolding a open_def
          by (auto simp: u_defs com_defs)
          let ?trn1 = "Trans s1 a ou1 s1'"
          have φ1: "φ ?trn1" using eqButPID_step_φ_imp[OF ss1 step step1 φ] .
          have ou1: "ou1 =
            O_sendPost (aid, clientPass s1 aid, PID, post s1 PID, owner s1 PID, vis s1 PID)"
          using φ1 step1 adm1 PID1 unfolding a by (cases ou1, auto simp: com_defs)
          have f1: "f ?trn1 = v1" using φ1 unfolding φ_def2[OF step1] v1 a ou1 aid1 pPID1 by auto
          have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
          have ?match proof
            show "validTrans ?trn1" using step1 by simp
          next
            show "consume ?trn1 vl1 ?vl1'" using φ1 unfolding consume_def ul1 f1 vl1 by simp
          next
            show "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" note γ = this
            have ou: "(∃ uid p aid pid.
               a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
               ou = ou1"
            using eqButPID_step_γ_out[OF ss1 step step1 op rsT rs1 γ] .
            thus "g ?trn = g ?trn1" by (cases a) auto
          next
            have corr1: "corrFrom (post s1' PID) ?vl1'"
            using cor1 unfolding vl1 ul1 v1 pPID1' by auto
            have ullull1: "ull1 ≠ [] ⟶ ull ≠ []" using ul ul1 lastul ulul1 unfolding v v1
            by fastforce
            have "Δ31 s' vl' s1' ?vl1'"
            using PID' op' s's1' lul lul1 map ulul1 cor1 BO ful ful1 lastul ulul1 lsul corr1 ullull1
            unfolding Δ31_def vl vl1 v1 vl' ul' ul ul1 v apply auto
            apply(rule exI[of _ "ull"]) apply(rule exI[of _ "ull1"]) apply(rule exI[of _ sul])
            apply(rule exI[of _ "vll"]) apply(rule exI[of _ "vll1"]) by auto
            thus "?Δ s' vl' s1' ?vl1'" by simp
          qed
          thus ?thesis using ul by simp
        next
        qed(insert lul ul, auto)
      next
        case False note φ = False
        hence ul': "ul' = ul" using cc unfolding consume_def by auto
        obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
        have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
        let ?trn1 = "Trans s1 a ou1 s1'"
        have φ1: "¬ φ ?trn1" using φ ss1 by (simp add: eqButPID_step_φ step step1)
        have pPID1': "post s1' PID = pst1" using PID1 pPID1 step1 φ1
          apply(cases a)
          subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
          subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
          subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
          subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
          subgoal by fastforce
          subgoal by fastforce
          subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
          done
        have op': "¬ open s'" using PID step φ op unfolding φ_def2[OF step] by auto
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def by simp
        next
          show "γ ?trn = γ ?trn1" unfolding ss1 by simp
        next
          assume "γ ?trn" note γ = this
          have ou: "(∃ uid p aid pid.
                 a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                 ou = ou1"
          using eqButPID_step_γ_out[OF ss1 step step1 op rsT rs1 γ] .
          thus "g ?trn = g ?trn1" by (cases a) auto
        next
          have "Δ31 s' vl' s1' vl1"
          using PID' pPID1 pPID1' op' s's1' lul lul1 map ulul1 cor1
            BO ful ful1 lastul ulul1 lsul cor1
          unfolding Δ31_def vl vl1 v1 vl' ul' apply simp
          apply(rule exI[of _ "ul"]) apply(rule exI[of _ "ul1"]) apply(rule exI[of _ sul])
          apply(rule exI[of _ "vll"]) apply(rule exI[of _ "vll1"]) by auto
          thus "?Δ s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl by simp
  qed(insert lul1 ul1, auto)
qed

lemma unwind_cont_Δ32: "unwind_cont Δ32 {Δ2,Δ32,Δ4}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ2 s vl s1 vl1 ∨ Δ32 s vl s1 vl1 ∨ Δ4 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ32 s vl s1 vl1"
  then obtain ul vll vll1 where
  lul: "list_all isPValS ul"
  and rs: "reach s" and ss1: "s1 = s" and op: "¬ open s" and PID: "PID ∈∈ postIDs s"
  and cor1: "corrFrom (post s1 PID) vl1"
  and vl: "vl = ul @ OVal True # vll"
  and vl1: "vl1 = ul @ OVal True # vll1"
  and BO: "BO vll vll1"
  using reachNT_reach unfolding Δ32_def by blast
  have own: "owner s PID ∈ set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  have adm: "admin s ∈ set (userIDs s)" using reach_admin_userIDs[OF rs own] .
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'" let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and c: "consume ?trn vl vl'"
      have PID': "PID ∈∈ postIDs s'" using reach_postIDs_persist[OF PID step] .
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'"
          (is "?match ∨ ?ignore")
      proof-
        have ?match proof(cases "ul = []")
          case False note ul = False
          then obtain ul' where cc: "consume ?trn ul ul'"
          and vl': "vl' = ul' @ OVal True # vll" using vl c unfolding consume_def
          by (cases "φ ?trn") auto
          let ?vl1' = "ul' @ OVal True # vll1"
          show ?thesis proof
            show "validTrans ?trn1" using step unfolding ss1 by simp
          next
            show "consume ?trn1 vl1 ?vl1'" using cc ul unfolding vl1 consume_def ss1
            by (cases "φ ?trn") auto
          next
            show "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" note γ = this
            thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            have "Δ32 s' vl' s' ?vl1'"
            proof(cases "φ ?trn")
              case True note φ = True
              then obtain v where f: "f ?trn = v" and  ul: "ul = v # ul'"
              using cc unfolding consume_def by (cases ul) auto
              define uid where uid: "uid ≡ admin s" define p where p: "p ≡ pass s uid"
              obtain aid pst where v: "v = PValS aid pst" using lul unfolding ul by (cases v) auto
              have a: "a = COMact (comSendPost (admin s) p aid PID)"
              using f_eq_PValS[OF step φ f[unfolded v]] unfolding uid p .
              have op': "¬ open s'" using uPost_comSendPost_open_eq[OF step] a op by auto
              have pPID': "post s' PID = post s PID"
              using step unfolding a by (auto simp: com_defs)
              show ?thesis using PID' pPID' op' cor1 BO lul
              unfolding Δ32_def vl1 ul ss1 v vl' by auto
            next
              case False note φ = False
              hence ul: "ul = ul'" using cc unfolding consume_def by (cases ul) auto
              have pPID': "post s' PID = post s PID"
                using step φ PID op
                apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
                subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
                subgoal by fastforce
                subgoal by fastforce
                subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
                done
              have op': "¬ open s'" using PID step φ op unfolding φ_def2[OF step] by auto
              show ?thesis using PID' pPID' op' cor1 BO lul
              unfolding Δ32_def vl1 ul ss1 vl' by auto
            qed
            thus "?Δ s' vl' s' ?vl1'" by simp
          qed
        next
          case True note ul = True
          show ?thesis proof(cases "φ ?trn")
            case True note φ = True
            hence f: "f ?trn = OVal True" and vl': "vl' = vll"
            using vl c unfolding consume_def ul by auto
            have op': "open s'" using f_eq_OVal[OF step φ f] op by simp
            show ?thesis proof
              show "validTrans ?trn1" using step unfolding ss1 by simp
            next
              show "consume ?trn1 vl1 vll1" using ul φ c
              unfolding vl1 vl' vl ss1 consume_def by auto
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" note γ = this
              thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              have pPID': "post s' PID = post s PID"
                using step φ PID op op' f
                apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
                subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
                subgoal by fastforce
                subgoal by fastforce
                subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
                done
              show "?Δ s' vl' s' vll1" using BO proof cases
                case BO_PVal
                hence "Δ2 s' vl' s' vll1" using PID' pPID' op' cor1 BO lul
                unfolding Δ2_def vl1 ul ss1 vl' by auto
                thus ?thesis by simp
              next
                case BO_BC
                hence "Δ4 s' vl' s' vll1" using PID' pPID' op' cor1 BO lul
                unfolding Δ4_def vl1 ul ss1 vl' by auto
                thus ?thesis by simp
              qed
            qed
          next
            case False note φ = False
            hence vl': "vl' = vl" using c unfolding consume_def by auto
            have pPID': "post s' PID = post s PID"
              using step φ PID op
              apply(cases a)
              subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
              subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
              subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
              subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
              subgoal by fastforce
              subgoal by fastforce
              subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
              done
            have op': "¬ open s'" using PID step φ op unfolding φ_def2[OF step] by auto
            show ?thesis proof
              show "validTrans ?trn1" using step unfolding ss1 by simp
            next
              show "consume ?trn1 vl1 vl1" using ul φ unfolding vl1 consume_def ss1 by simp
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" note γ = this
              thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              have "Δ32 s' vl' s' vl1" using PID' pPID' op' cor1 BO lul
              unfolding Δ32_def vl vl1 ul ss1 vl' apply simp
              apply(rule exI[of _ "[]"])
              apply(rule exI[of _ vll]) apply(rule exI[of _ vll1]) by auto
              thus "?Δ s' vl' s' vl1" by simp
            qed
          qed
        qed
        thus ?thesis by simp
      qed
    qed
  thus ?thesis using vl by simp
  qed
qed

lemma unwind_cont_Δ2: "unwind_cont Δ2 {Δ2}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ2 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ2 s vl s1 vl1"
  hence vlvl1: "vl = vl1"
  and rs: "reach s" and ss1: "s1 = s" and op: "open s" and PID: "PID ∈∈ postIDs s"
  and cor1: "corrFrom (post s1 PID) vl1" and lvl: "list_all (Not ∘ isOVal) vl"
  using reachNT_reach unfolding Δ2_def by auto
  have own: "owner s PID ∈ set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  have adm: "admin s ∈ set (userIDs s)" using reach_admin_userIDs[OF rs own] .
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and c: "consume ?trn vl vl'"
      have PID': "PID ∈∈ postIDs s'" using reach_postIDs_persist[OF PID step] .
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof-
        have ?match proof(cases "φ ?trn")
          case True note φ = True
          then obtain v where vl: "vl = v # vl'" and f: "f ?trn = v"
          using c unfolding consume_def φ_def2 by(cases vl) auto
          show ?thesis proof(cases v)
            case (PVal pst) note v = PVal
            have a: "a = Uact (uPost (owner s PID) (pass s (owner s PID)) PID pst)"
            using f_eq_PVal[OF step φ f[unfolded v]] .
            have ou: "ou = outOK" using step own PID unfolding a by (auto simp: u_defs)
            have op': "open s'" using step op PID PID' φ
            unfolding open_def a by (auto simp: u_defs)
            have pPID': "post s' PID = pst"
            using step φ PID op f op' unfolding a by(auto simp: u_defs)
            show ?thesis proof
              show "validTrans ?trn1" unfolding ss1 using step by simp
            next
              show "consume ?trn1 vl1 vl'" using φ vlvl1 unfolding ss1 consume_def vl f by auto
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              show "?Δ s' vl' s' vl'" using cor1 PID' pPID' op' lvl vlvl1 ss1
              unfolding Δ2_def vl v by auto
            qed
          next
            case (PValS aid pid) note v = PValS
            have a: "a = COMact (comSendPost (admin s) (pass s (admin s)) aid PID)"
            using f_eq_PValS[OF step φ f[unfolded v]] .
            have op': "open s'" using step op PID PID' φ
            unfolding open_def a by (auto simp: com_defs)
            have ou: "ou ≠ outErr" using φ op op' unfolding φ_def2[OF step] unfolding a by auto
            have pPID': "post s' PID = post s PID"
            using step φ PID op f op' unfolding a by(auto simp: com_defs)
            show ?thesis proof
              show "validTrans ?trn1" unfolding ss1 using step by simp
            next
              show "consume ?trn1 vl1 vl'" using φ vlvl1 unfolding ss1 consume_def vl f by auto
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              show "?Δ s' vl' s' vl'" using cor1 PID' pPID' op' lvl vlvl1 ss1
              unfolding Δ2_def vl v by auto
            qed
          qed(insert vl lvl, auto)
        next
          case False note φ = False
          hence vl': "vl' = vl" using c unfolding consume_def by auto
          have pPID': "post s' PID = post s PID"
            using step φ PID op
            apply(cases a)
            subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
            subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
            subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
            subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
            subgoal by fastforce
            subgoal by fastforce
            subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
            done
          have op': "open s'" using PID step φ op unfolding φ_def2[OF step] by auto
          show ?thesis proof
            show "validTrans ?trn1" unfolding ss1 using step by simp
          next
            show "consume ?trn1 vl1 vl" using φ vlvl1 unfolding ss1 consume_def vl' by simp
          next
            show "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            show "?Δ s' vl' s' vl" using cor1 PID' op' lvl vlvl1 pPID'
            unfolding Δ2_def vl' ss1 by auto
          qed
        qed
      thus ?thesis by simp
      qed
    qed
  thus ?thesis using vlvl1 by simp
  qed
qed

lemma unwind_cont_Δ4: "unwind_cont Δ4 {Δ1,Δ31,Δ32,Δ4}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ1 s vl s1 vl1 ∨ Δ31 s vl s1 vl1 ∨ Δ32 s vl s1 vl1 ∨ Δ4 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ4 s vl s1 vl1"
  then obtain ul vll vll1 where vl: "vl = ul @ OVal False # vll" and vl1: "vl1 = ul @ OVal False # vll1"
  and rs: "reach s" and ss1: "s1 = s" and op: "open s" and PID: "PID ∈∈ postIDs s"
  and cor1: "corrFrom (post s1 PID) vl1" and lul: "list_all (Not ∘ isOVal) ul"
  and BC: "BC vll vll1"
  using reachNT_reach unfolding Δ4_def by blast
  have own: "owner s PID ∈ set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  have adm: "admin s ∈ set (userIDs s)" using reach_admin_userIDs[OF rs own] .
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and c: "consume ?trn vl vl'"
      have PID': "PID ∈∈ postIDs s'" using reach_postIDs_persist[OF PID step] .
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof-
        have ?match proof(cases "φ ?trn")
          case True note φ = True
          then obtain v where vl_vl': "vl = v # vl'" and f: "f ?trn = v"
          using c unfolding consume_def φ_def2 by(cases vl) auto
          show ?thesis proof(cases "ul = []")
            case False note ul = False
            then obtain ul' where ul: "ul = v # ul'" and vl': "vl' = ul' @ OVal False # vll"
            using c φ f unfolding consume_def vl by (cases ul) auto
            let ?vl1' = "ul' @ OVal False # vll1"
            show ?thesis proof(cases v)
              case (PVal pst) note v = PVal
              have a: "a = Uact (uPost (owner s PID) (pass s (owner s PID)) PID pst)"
              using f_eq_PVal[OF step φ f[unfolded v]] .
              have ou: "ou = outOK" using step own PID unfolding a by (auto simp: u_defs)
              have op': "open s'" using step op PID PID' φ
              unfolding open_def a by (auto simp: u_defs)
              have pPID': "post s' PID = pst"
              using step φ PID op f op' unfolding a by(auto simp: u_defs)
              show ?thesis proof
                show "validTrans ?trn1" unfolding ss1 using step by simp
              next
                show "consume ?trn1 vl1 ?vl1'" using φ
                unfolding ss1 consume_def vl f ul vl1 vl' by simp
              next
                show "γ ?trn = γ ?trn1" unfolding ss1 by simp
              next
                assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
              next
                have "Δ4 s' vl' s' ?vl1'" using cor1 PID' pPID' op' vl1 ss1 lul BC
                unfolding Δ4_def vl v ul vl' apply simp
                apply(rule exI[of _ ul'])
                apply(rule exI[of _ vll]) apply(rule exI[of _ vll1])
                by auto
                thus "?Δ s' vl' s' ?vl1'" by simp
              qed
            next
              case (PValS aid pid) note v = PValS
              have a: "a = COMact (comSendPost (admin s) (pass s (admin s)) aid PID)"
              using f_eq_PValS[OF step φ f[unfolded v]] .
              have op': "open s'" using step op PID PID' φ
              unfolding open_def a by (auto simp: com_defs)
              have ou: "ou ≠ outErr" using φ op op' unfolding φ_def2[OF step] unfolding a by auto
              have pPID': "post s' PID = post s PID"
              using step φ PID op f op' unfolding a by(auto simp: com_defs)
              show ?thesis proof
                show "validTrans ?trn1" unfolding ss1 using step by simp
              next
                show "consume ?trn1 vl1 ?vl1'" using φ
                unfolding ss1 consume_def vl f ul vl1 vl' by simp
              next
                show "γ ?trn = γ ?trn1" unfolding ss1 by simp
              next
                assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
              next
                have "Δ4 s' vl' s' ?vl1'" using cor1 PID' pPID' op' vl1 ss1 lul BC
                unfolding Δ4_def vl v ul vl' by auto
                thus "?Δ s' vl' s' ?vl1'" by simp
              qed
            qed(insert vl lul ul, auto)
          next
            case True note ul = True
            hence f: "f ?trn = OVal False" and vl': "vl' = vll"
            using vl c f φ unfolding consume_def ul by auto
            have op': "¬ open s'" using f_eq_OVal[OF step φ f] op by simp
            show ?thesis proof
              show "validTrans ?trn1" using step unfolding ss1 by simp
            next
              show "consume ?trn1 vl1 vll1" using ul φ c
              unfolding vl1 vl' vl ss1 consume_def by auto
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" note γ = this
              thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              have pPID': "post s' PID = post s PID"
                using step φ PID op op' f
                apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
                subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
                subgoal by fastforce
                subgoal by fastforce
                subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
                done
              show "?Δ s' vl' s' vll1" using BC proof cases
                case BC_PVal
                hence "Δ1 s' vl' s' vll1" using PID' pPID' op' cor1 BC lul
                unfolding Δ1_def vl1 ul ss1 vl' by auto
                thus ?thesis by simp
              next
                case (BC_BO Vll Vll1 Ul Ul1 Sul)
                show ?thesis proof(cases "Ul ≠ [] ∧ Ul1 ≠ []")
                  case True
                  hence "Δ31 s' vl' s' vll1" using PID' pPID' op' cor1 BC BC_BO lul
                  unfolding Δ31_def vl1 ul ss1 vl' apply simp
                  apply(rule exI[of _ Ul]) apply(rule exI[of _ Ul1])
                  apply(rule exI[of _ Sul])
                  apply(rule exI[of _ Vll]) apply(rule exI[of _ Vll1])
                  by auto
                  thus ?thesis by simp
                next
                  case False
                  hence 0: "Ul = []" "Ul1 = []" using BC_BO by auto
                  hence "Δ32 s' vl' s' vll1" using PID' pPID' op' cor1 BC BC_BO lul
                  unfolding Δ32_def vl1 ul ss1 vl' apply simp
                  apply(rule exI[of _ Sul])
                  apply(rule exI[of _ Vll]) apply(rule exI[of _ Vll1])
                  by auto
                  thus ?thesis by simp
                qed
              qed
            qed
          qed
        next
          case False note φ = False
          hence vl': "vl' = vl" using c unfolding consume_def by auto
          have pPID': "post s' PID = post s PID"
            using step φ PID op
            apply(cases a)
            subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
            subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
            subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
            subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
            subgoal by fastforce
            subgoal by fastforce
            subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
            done
          have op': "open s'" using PID step φ op unfolding φ_def2[OF step] by auto
          show ?thesis proof
            show "validTrans ?trn1" unfolding ss1 using step by simp
          next
            show "consume ?trn1 vl1 vl1" using φ unfolding ss1 consume_def vl' vl vl1 by simp
          next
            show "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            have "Δ4 s' vl' s' vl1" using cor1 PID' pPID' op' vl1 ss1 lul BC
            unfolding Δ4_def vl vl' by auto
            thus "?Δ s' vl' s' vl1" by simp
          qed
        qed
      thus ?thesis by simp
      qed
    qed
  thus ?thesis using vl by simp
  qed
qed

definition Gr where
"Gr =
 {
 (Δ0, {Δ0,Δ1,Δ2,Δ31,Δ32,Δ4}),
 (Δ1, {Δ1,Δ11}),
 (Δ11, {Δ11}),
 (Δ2, {Δ2}),
 (Δ31, {Δ31,Δ32}),
 (Δ32, {Δ2,Δ32,Δ4}),
 (Δ4, {Δ1,Δ31,Δ32,Δ4})
 }"


theorem secure: secure
apply (rule unwind_decomp_secure_graph[of Gr Δ0])
unfolding Gr_def
apply (simp, smt insert_subset order_refl)
using
istate_Δ0 unwind_cont_Δ0 unwind_cont_Δ1 unwind_cont_Δ11
unwind_cont_Δ31 unwind_cont_Δ32 unwind_cont_Δ2 unwind_cont_Δ4
unfolding Gr_def by auto




end

end
ad>

Theory DYNAMIC_Post_COMPOSE2

theory DYNAMIC_Post_COMPOSE2
  imports
    DYNAMIC_Post_ISSUER
    Post_RECEIVER
    "BD_Security_Compositional.Composing_Security"
begin

subsubsection ‹Confidentiality for the (binary) issuer-receiver composition›

type_synonym ttrans = "(state, act, out) trans"
type_synonym value1 = Post.value  type_synonym value2 = Post_RECEIVER.value
type_synonym obs1 = Post_Observation_Setup_ISSUER.obs
type_synonym obs2 = Post_Observation_Setup_RECEIVER.obs

(* irrelevant for the security conditions: *)
datatype cval = PValC post
type_synonym cobs = "obs1 × obs2"

locale Post_COMPOSE2 =
  Iss: Post UIDs PID +
  Rcv: Post_RECEIVER UIDs2 PID AID1
for UIDs :: "userID set" and UIDs2 :: "userID set" and
   AID1 :: "apiID" and PID :: "postID"
+ fixes AID2 :: "apiID"
begin

abbreviation "φ1 ≡ Iss.φ"  abbreviation "f1 ≡ Iss.f" abbreviation "γ1 ≡ Iss.γ"  abbreviation "g1 ≡ Iss.g"
  abbreviation "T1 ≡ Iss.T"  abbreviation "B1 ≡ Iss.B"
abbreviation "φ2 ≡ Rcv.φ"  abbreviation "f2 ≡ Rcv.f" abbreviation "γ2 ≡ Rcv.γ"  abbreviation "g2 ≡ Rcv.g"
  abbreviation "T2 ≡ Rcv.T"  abbreviation "B2 ≡ Rcv.B"

(* Recall that we assume that the system prevents communication if error occurs: *)
fun isCom1 :: "ttrans ⇒ bool" where
 "isCom1 (Trans s (COMact ca1) ou1 s') = (ou1 ≠ outErr)"
|"isCom1 _ = False"

fun isCom2 :: "ttrans ⇒ bool" where
 "isCom2 (Trans s (COMact ca2) ou2 s') = (ou2 ≠ outErr)"
|"isCom2 _ = False"

fun isComV1 :: "value1 ⇒ bool" where
 "isComV1 (Iss.PValS aid1 pst1) = True"
|"isComV1 _ = False"

fun isComV2 :: "value2 ⇒ bool" where
 "isComV2 (Rcv.PValR pst2) = True"
(* |"isComV2 _ = False" *)

fun syncV :: "value1 ⇒ value2 ⇒ bool" where
 "syncV (Iss.PValS aud1 pst1) (Rcv.PValR pst2) = (pst1 = pst2)"
|"syncV _ _ = False"

(* irrelevant for the security conditions: *)
fun cmpV :: "value1 ⇒ value2 ⇒ cval"  where
 "cmpV (Iss.PValS aid1 pst1) (Rcv.PValR pst2) = PValC pst1"
|"cmpV _ _ = undefined"

fun isComO1 :: "obs1 ⇒ bool" where
 "isComO1 (COMact ca1, ou1) = (ou1 ≠ outErr)"
|"isComO1 _ = False"

fun isComO2 :: "obs2 ⇒ bool" where
 "isComO2 (COMact ca2, ou2) = (ou2 ≠ outErr)"
|"isComO2 _ = False"

fun comSyncOA :: "out ⇒ comActt ⇒ bool" where
 "comSyncOA (O_sendServerReq (aid2, reqInfo1)) (comReceiveClientReq aid1 reqInfo2) =
   (aid1 = AID1 ∧ aid2 = AID2 ∧ reqInfo1 = reqInfo2)"
|"comSyncOA (O_connectClient (aid2, sp1)) (comConnectServer aid1 sp2) =
   (aid1 = AID1 ∧ aid2 = AID2 ∧ sp1 = sp2)"
|"comSyncOA (O_sendPost (aid2, sp1, pid1, pst1, uid1, vs1)) (comReceivePost aid1 sp2 pid2 pst2 uid2 vs2) =
   (aid1 = AID1 ∧ aid2 = AID2 ∧ (pid1, pst1, uid1, vs1) = (pid2, pst2, uid2, vs2))"
|"comSyncOA (O_sendCreateOFriend (aid2, sp1, uid1, uid1')) (comReceiveCreateOFriend aid1 sp2 uid2 uid2') =
   (aid1 = AID1 ∧ aid2 = AID2 ∧ (uid1, uid1') = (uid2, uid2'))"
|"comSyncOA (O_sendDeleteOFriend (aid2, sp1, uid1, uid1')) (comReceiveDeleteOFriend aid1 sp2 uid2 uid2') =
   (aid1 = AID1 ∧ aid2 = AID2 ∧ (uid1, uid1') = (uid2, uid2'))"
|"comSyncOA _ _ = False"

fun syncO :: "obs1 ⇒ obs2 ⇒ bool" where
 "syncO (COMact ca1, ou1) (COMact ca2, ou2) =
  (ou1 ≠ outErr ∧ ou2 ≠ outErr ∧
   (comSyncOA ou1 ca2 ∨ comSyncOA ou2 ca1)
  )"
|"syncO _ _ = False"

fun sync :: "ttrans ⇒ ttrans ⇒ bool" where
"sync (Trans s1 a1 ou1 s1') (Trans s2 a2 ou2 s2') = syncO (a1, ou1) (a2, ou2)"

(* irrelevant for the security conditions: *)
definition cmpO :: "obs1 ⇒ obs2 ⇒ cobs"  where
"cmpO o1 o2 ≡ (o1,o2)"


(*  *)



lemma isCom1_isComV1:
assumes v: "validTrans trn1" and r: "reach (srcOf trn1)" and φ1: "φ1 trn1"
shows "isCom1 trn1 ⟷ isComV1 (f1 trn1)"
proof (cases trn1)
  case (Trans s1 a1 o1 s1')
  hence step: "step s1 a1 = (o1, s1')" using v by simp
  show ?thesis using φ1[unfolded Trans] unfolding Iss.φ_def3[OF step]
  proof (elim exE disjE conjE)
    assume "Iss.open s1 ≠ Iss.open s1'"
    and a1: "¬ isCOMact a1" "¬ (∃ ua. isuPost ua ∧ a1 = Uact ua)"
    hence "Iss.f (Trans s1 a1 o1 s1') = Iss.OVal (Iss.open s1')" using Iss.f_open_OVal[OF step] by auto
    thus ?thesis unfolding Trans using a1 by (cases a1) auto
  qed(unfold Trans, auto)
qed

lemma isCom1_isComO1:
assumes "validTrans trn1" and "reach (srcOf trn1)" and "γ1 trn1"
shows "isCom1 trn1 ⟷ isComO1 (g1 trn1)"
using assms apply(cases trn1)
subgoal for _ x2 apply(cases x2) by auto .

lemma isCom2_isComV2:
assumes "validTrans trn2" and "reach (srcOf trn2)" and "φ2 trn2"
shows "isCom2 trn2 ⟷ isComV2 (f2 trn2)"
using assms apply(cases trn2) by (auto simp: Rcv.φ_def2 split: prod.splits)

lemma isCom2_isComO2:
assumes "validTrans trn2" and "reach (srcOf trn2)" and "γ2 trn2"
shows "isCom2 trn2 ⟷ isComO2 (g2 trn2)"
using assms apply(cases trn2)
subgoal for _ x2 apply(cases x2) by auto .

lemma sync_syncV:
assumes v1: "validTrans trn1" and "reach (srcOf trn1)"
and v2: "validTrans trn2" and "reach (srcOf trn2)"
and c1: "isCom1 trn1" and c2: "isCom2 trn2" and φ1: "φ1 trn1" and φ2: "φ2 trn2"
and snc: "sync trn1 trn2"
shows "syncV (f1 trn1) (f2 trn2)"
proof (cases trn1)
  case (Trans s1 a1 o1 s1') note trn1 = Trans
  show ?thesis proof(cases trn2)
    case (Trans s2 a2 o2 s2') note trn2 = Trans
    have step1: "step s1 a1 = (o1, s1')" and step2: "step s2 a2 = (o2, s2')"
    using v1 v2 trn1 trn2 by auto
    obtain uid2 pst2 vs2
    where a2: "a2 = COMact
        (comReceivePost AID1 (serverPass s2 AID1) PID pst2 uid2 vs2)"
    and o2: "o2 = outOK" using φ2[unfolded trn2]
    unfolding Rcv.φ_def3[OF step2] by auto
    hence f2: "Rcv.f trn2 = Rcv.PValR pst2" unfolding trn2 by simp
    show ?thesis using φ1[unfolded trn1]
    unfolding Iss.φ_def3[OF step1]
    proof (elim exE disjE conjE)
      assume "Iss.open s1 ≠ Iss.open s1'"
      and a1: "¬ isCOMact a1" "¬ (∃ ua. isuPost ua ∧ a1 = Uact ua)"
      hence f1: "Iss.f (Trans s1 a1 o1 s1') = Iss.OVal (Iss.open s1')"
      using Iss.f_open_OVal step1 step2 by auto
      thus ?thesis using a1 c1 c2 unfolding trn1 trn2 a2 o2 f2
      by (cases a1, auto)
    qed(insert snc c1 c2, unfold trn1 trn2 a2, auto)
  qed
qed

lemma sync_syncO:
assumes "validTrans trn1" and "reach (srcOf trn1)"
and "validTrans trn2" and "reach (srcOf trn2)"
and "isCom1 trn1" and "isCom2 trn2" and "γ1 trn1" and "γ2 trn2"
and "sync trn1 trn2"
shows "syncO (g1 trn1) (g2 trn2)"
proof(cases trn1)
  case (Trans s1 a1 ou1 s1') note trn1 = Trans
  show ?thesis proof(cases trn2)
    case (Trans s2 a2 ou2 s2') note trn2 = Trans
    show ?thesis
    proof(cases a1)
      case (COMact ca1) note a1 = COMact
      show ?thesis
      proof(cases a2)
        case (COMact ca2) note a2 = COMact
        show ?thesis
        using assms unfolding trn1 trn2 a1 a2
        apply(cases ca1) by (cases ca2, auto split: prod.splits)+
      qed(insert assms, unfold trn1 trn2, auto)
    qed(insert assms, unfold trn1 trn2, auto)
  qed
qed

lemma sync_φ1_φ2:
assumes v1: "validTrans trn1" and r1: "reach (srcOf trn1)"
and v2: "validTrans trn2" and s2: "reach (srcOf trn2)"
and c1: "isCom1 trn1" and c2: "isCom2 trn2"
and sn: "sync trn1 trn2"
shows "φ1 trn1 ⟷ φ2 trn2" (is "?A ⟷ ?B")
proof(cases trn1)
  case (Trans s1 a1 ou1 s1') note trn1 = Trans
  hence step1: "step s1 a1 = (ou1,s1')" using v1 by auto
  show ?thesis proof(cases trn2)
    case (Trans s2 a2 ou2 s2') note trn2 = Trans
    hence step2: "step s2 a2 = (ou2,s2')" using v2 by auto
    show ?thesis
    proof(cases a1)
      case (COMact ca1) note a1 = COMact
      show ?thesis
      proof(cases a2)
        case (COMact ca2) note a2 = COMact

        have "?A ⟷ (∃aid1. ca1 =
             (comSendPost (admin s1) (pass s1 (admin s1)) aid1
               PID) ∧
            ou1 =
            O_sendPost
             (aid1, clientPass s1 aid1, PID, post s1 PID,
              owner s1 PID, vis s1 PID))"
        using c1 unfolding trn1 Iss.φ_def3[OF step1] unfolding a1 by auto
        also have "… ⟷ (∃uid2 pst2 vs2.
        ca2 = comReceivePost AID1 (serverPass s2 AID1) PID pst2 uid2 vs2 ∧ ou2 = outOK)"
        using sn step1 step2 unfolding trn1 trn2 a1 a2
        apply(cases ca1) by (cases ca2, auto simp: all_defs)+
        also have "… ⟷ ?B"
        using c2 unfolding trn2 Rcv.φ_def3[OF step2] unfolding a2 by auto
        finally show ?thesis .
      qed(insert assms, unfold trn1 trn2, auto)
    qed(insert assms, unfold trn1 trn2, auto)
  qed
qed

lemma textPost_textPost_cong[intro]:
assumes "textPost pst1 = textPost pst2"
and "setTextPost pst1 emptyText = setTextPost pst2 emptyText"
shows "pst1 = pst2"
using assms by (cases pst1, cases pst2) auto

lemma sync_φ_γ:
assumes "validTrans trn1" and "reach (srcOf trn1)"
and "validTrans trn2" and "reach (srcOf trn2)"
and "isCom1 trn1" and "isCom2 trn2"
and "γ1 trn1" and "γ2 trn2"
and so: "syncO (g1 trn1) (g2 trn2)"
and "φ1 trn1 ⟹ φ2 trn2 ⟹ syncV (f1 trn1) (f2 trn2)"
shows "sync trn1 trn2"
proof(cases trn1, cases trn2)
  fix s1 a1 ou1 s1' s2 a2 ou2 s2'
  assume trn1: "trn1 = Trans s1 a1 ou1 s1'"
  and trn2: "trn2 = Trans s2 a2 ou2 s2'"
  hence step1: "step s1 a1 = (ou1,s1')" and step2: "step s2 a2 = (ou2,s2')" using assms by auto
  show ?thesis
  proof(cases a1)
    case (COMact ca1) note a1 = COMact
    show ?thesis
    proof(cases a2)
      case (COMact ca2) note a2 = COMact
      show ?thesis
      proof(cases ca1)   term comReceivePost
        case (comSendPost uid1 p1 aid1 pid) note ca1 = comSendPost
        then obtain pst where p1: "p1 = pass s1 (admin s1)" and
        aid1: "aid1 = AID2" and ou2: "ou2 = outOK" and ou1: "ou1 ≠ outErr" and
        ca2: "ca2 = comReceivePost AID1 (serverPass s2 AID1) pid pst (owner s1 pid) (vis s1 pid)"
        using so step1 step2 unfolding trn1 trn2 a1 a2 ca1
        by (cases ca2, auto simp: all_defs)
        have ou1: "ou1 = O_sendPost (AID2,clientPass s1 AID2,pid, post s1 pid, owner s1 pid, vis s1 pid)"
        using step1 ou1 unfolding a1 ca1 aid1 by (auto simp: all_defs)
        show ?thesis proof(cases "pid = PID")
          case False thus ?thesis using so step1 step2 unfolding trn1 trn2 a1 a2 ca1 ca2
          by (auto simp: all_defs)
        next
          case True  note pid = True
          hence "φ1 trn1 ∧ φ2 trn2" using ou1 ou2 unfolding trn1 trn2 a1 a2 ca1 ca2 by auto
          hence "syncV (f1 trn1) (f2 trn2)" using assms by simp
          hence pst: "pst = post s1 PID" using pid unfolding trn1 trn2 a1 a2 ca1 ca2 aid1 ou1 by auto
          show ?thesis unfolding trn1 trn2 a1 a2 ca1 ca2 ou1 ou2 pst pid by auto
        qed
      qed(insert so step1 step2, unfold trn1 trn2 a1 a2, (cases ca2, auto simp: all_defs)+)
    qed(insert assms, unfold trn1 trn2, auto)
  qed(insert assms, unfold trn1 trn2, auto)
qed

lemma isCom1_γ1:
assumes "validTrans trn1" and "reach (srcOf trn1)" and "isCom1 trn1"
shows "γ1 trn1"
proof(cases trn1)
  case (Trans s1 a1 ou1 s1')
  thus ?thesis using assms by (cases a1) auto
qed

lemma isCom2_γ2:
assumes "validTrans trn2" and "reach (srcOf trn2)" and "isCom2 trn2"
shows "γ2 trn2"
proof(cases trn2)
  case (Trans s2 a2 ou2 s2')
  thus ?thesis using assms by (cases a2) auto
qed

lemma isCom2_V2:
assumes "validTrans trn2" and "reach (srcOf trn2)" and "φ2 trn2"
shows "isCom2 trn2"
proof(cases trn2)
  case (Trans s2 a2 ou2 s2') note trn2 = Trans
  show ?thesis
  proof(cases a2)
    case (COMact ca2)
    thus ?thesis using assms trn2 by (cases ca2) auto
  qed(insert assms trn2, auto)
qed

end (* context Post_COMPOSE2 *)


sublocale Post_COMPOSE2 < BD_Security_TS_Comp where
  istate1 = istate and validTrans1 = validTrans and srcOf1 = srcOf and tgtOf1 = tgtOf
    and φ1 = φ1 and f1 = f1 and γ1 = γ1 and g1 = g1 and T1 = T1 and B1 = B1
  and
  istate2 = istate and validTrans2 = validTrans and srcOf2 = srcOf and tgtOf2 = tgtOf
    and φ2 = φ2 and f2 = f2 and γ2 = γ2 and g2 = g2 and T2 = T2 and B2 = B2
  and isCom1 = isCom1 and isCom2 = isCom2 and sync = sync
  and isComV1 = isComV1 and isComV2 = isComV2 and syncV = syncV
  and isComO1 = isComO1 and isComO2 = isComO2 and syncO = syncO
apply standard
using isCom1_isComV1 isCom1_isComO1 isCom2_isComV2 isCom2_isComO2
  sync_syncV sync_syncO
apply auto
apply (meson sync_φ1_φ2, meson sync_φ1_φ2)
using sync_φ_γ apply auto
using isCom1_γ1 isCom2_γ2 isCom2_V2 apply auto
by (meson isCom2_V2)


context Post_COMPOSE2
begin


theorem secure: "secure"
  using secure1_secure2_secure[OF Iss.secure Rcv.Post_secure] .


end (* context Post_COMPOSE2 *)

end
d>

Theory DYNAMIC_Post_Network

theory DYNAMIC_Post_Network
  imports
    DYNAMIC_Post_ISSUER
    Post_RECEIVER
    "../API_Network"
    "BD_Security_Compositional.Composing_Security_Network"
begin

subsubsection ‹Confidentiality for the N-ary composition›

type_synonym ttrans = "(state, act, out) trans"
type_synonym obs = Post_Observation_Setup_ISSUER.obs
type_synonym "value" = "Post.value + Post_RECEIVER.value"

lemma value_cases:
fixes v :: "value"
obtains (PVal) pst where "v = Inl (Post.PVal pst)"
      | (PValS) aid pst where "v = Inl (Post.PValS aid pst)"
      | (OVal) ov where "v = Inl (Post.OVal ov)"
      | (PValR) pst where "v = Inr (Post_RECEIVER.PValR pst)"
proof (cases v)
  case (Inl vl) then show thesis using PVal PValS OVal by (cases vl rule: Post.value.exhaust) auto next
  case (Inr vr) then show thesis using PValR by (cases vr rule: Post_RECEIVER.value.exhaust) auto
qed

locale Post_Network = Network
+ fixes UIDs :: "apiID ⇒ userID set"
  and AID :: "apiID" and PID :: "postID"
  assumes AID_in_AIDs: "AID ∈ AIDs"
begin

sublocale Iss: Post "UIDs AID" PID .

abbreviation φ :: "apiID ⇒ (state, act, out) trans ⇒ bool"
where "φ aid trn ≡ (if aid = AID then Iss.φ trn else Post_RECEIVER.φ PID AID trn)"

abbreviation f :: "apiID ⇒ (state, act, out) trans ⇒ value"
where "f aid trn ≡ (if aid = AID then Inl (Iss.f trn) else Inr (Post_RECEIVER.f PID AID trn))"

abbreviation γ :: "apiID ⇒ (state, act, out) trans ⇒ bool"
where "γ aid trn ≡ (if aid = AID then Iss.γ trn else ObservationSetup_RECEIVER.γ (UIDs aid) trn)"

abbreviation g :: "apiID ⇒ (state, act, out) trans ⇒ obs"
where "g aid trn ≡ (if aid = AID then Iss.g trn else ObservationSetup_RECEIVER.g PID AID trn)"

abbreviation T :: "apiID ⇒ (state, act, out) trans ⇒ bool"
  where "T aid trn ≡ (if aid = AID then Iss.T trn else Post_RECEIVER.T (UIDs aid) PID AID trn)"

(* Note that Iss.T is trivially False (since the issuer being dynamic, the trigger
is incorporated in the bound) so an alternative definition of the composite trigger is:  *)
lemma T_def:
"T aid trn ⟷ aid ≠ AID ∧ Post_RECEIVER.T (UIDs aid) PID AID trn"
by auto

abbreviation B :: "apiID ⇒ value list ⇒ value list ⇒ bool"
where "B aid vl vl1 ≡
  (if aid = AID then list_all isl vl ∧ list_all isl vl1 ∧ Iss.B (map projl vl) (map projl vl1)
   else list_all (Not o isl) vl ∧ list_all (Not o isl) vl1 ∧ Post_RECEIVER.B (map projr vl) (map projr vl1))"

fun comOfV :: "apiID ⇒ value ⇒ com" where
  "comOfV aid (Inl (Post.PValS aid' pst)) = (if aid' ≠ aid then Send else Internal)"
| "comOfV aid (Inl (Post.PVal pst)) = Internal"
| "comOfV aid (Inl (Post.OVal ov)) = Internal"
| "comOfV aid (Inr v) = Recv"

fun tgtNodeOfV :: "apiID ⇒ value ⇒ apiID" where
  "tgtNodeOfV aid (Inl (Post.PValS aid' pst)) = aid'"
| "tgtNodeOfV aid (Inl (Post.PVal pst)) = undefined"
| "tgtNodeOfV aid (Inl (Post.OVal ov)) = undefined"
| "tgtNodeOfV aid (Inr v) = AID"

definition syncV :: "apiID ⇒ value ⇒ apiID ⇒ value ⇒ bool" where
  "syncV aid1 v1 aid2 v2 =
    (∃pst. aid1 = AID ∧ v1 = Inl (Post.PValS aid2 pst) ∧ v2 = Inr (Post_RECEIVER.PValR pst))"

lemma syncVI: "syncV AID (Inl (Post.PValS aid' pst)) aid' (Inr (Post_RECEIVER.PValR pst))"
unfolding syncV_def by auto

lemma syncVE:
assumes "syncV aid1 v1 aid2 v2"
obtains pst where "aid1 = AID" "v1 = Inl (Post.PValS aid2 pst)" "v2 = Inr (Post_RECEIVER.PValR pst)"
using assms unfolding syncV_def by auto

fun getTgtV where
  "getTgtV (Inl (Post.PValS aid pst)) = Inr (Post_RECEIVER.PValR pst)"
| "getTgtV v = v"

lemma comOfV_AID:
  "comOfV AID v = Send ⟷ isl v ∧ Iss.isPValS (projl v) ∧ Iss.tgtAPI (projl v) ≠ AID"
  "comOfV AID v = Recv ⟷ Not (isl v)"
by (cases v rule: value_cases; auto)+

lemmas φ_defs = Post_RECEIVER.φ_def2 Iss.φ_def3

sublocale Net: BD_Security_TS_Network_getTgtV
where istate = "λ_. istate" and validTrans = validTrans and srcOf = "λ_. srcOf" and tgtOf = "λ_. tgtOf"
  and nodes = AIDs and comOf = comOf and tgtNodeOf = tgtNodeOf
  and sync = sync and φ = φ and f = f and γ = γ and g = g and T = T and B = B
  and comOfV = comOfV and tgtNodeOfV = tgtNodeOfV and syncV = syncV
  and comOfO = comOfO and tgtNodeOfO = tgtNodeOfO and syncO = syncO (*and cmpO = cmpO*)
  and source = AID and getTgtV = getTgtV
using AID_in_AIDs proof (unfold_locales, goal_cases)
  case (1 nid trn) then show ?case using Iss.validTrans_isCOMact_open[of trn] by (cases trn rule: Iss.φ.cases) (auto simp: φ_defs split: prod.splits) next
  case (2 nid trn) then show ?case using Iss.validTrans_isCOMact_open[of trn] by (cases trn rule: Iss.φ.cases) (auto simp: φ_defs split: prod.splits) next
  case (3 nid trn)
    interpret Sink: Post_RECEIVER "UIDs nid" PID AID .
    show ?case using 3 by (cases "(nid,trn)" rule: tgtNodeOf.cases) (auto split: prod.splits)
next
  case (4 nid trn)
    interpret Sink: Post_RECEIVER "UIDs nid" PID AID .
    show ?case using 4 by (cases "(nid,trn)" rule: tgtNodeOf.cases) (auto split: prod.splits)
next
  case (5 nid1 trn1 nid2 trn2)
    interpret Sink1: Post_RECEIVER "UIDs nid1" PID AID .
    interpret Sink2: Post_RECEIVER "UIDs nid2" PID AID .
    show ?case using 5 by (elim sync_cases) (auto intro: syncVI)
next
  case (6 nid1 trn1 nid2 trn2)
    interpret Sink1: Post_RECEIVER "UIDs nid1" PID AID .
    interpret Sink2: Post_RECEIVER "UIDs nid2" PID AID .
    show ?case using 6 by (elim sync_cases) auto
next
  case (7 nid1 trn1 nid2 trn2)
    interpret Sink1: Post_RECEIVER "UIDs nid1" PID AID .
    interpret Sink2: Post_RECEIVER "UIDs nid2" PID AID .
    show ?case using 7(2,4,6-10)
      using Iss.validTrans_isCOMact_open[OF 7(2)] Iss.validTrans_isCOMact_open[OF 7(4)]
      by (elim sync_cases) (auto split: prod.splits, auto simp: sendPost_def)
next
  case (8 nid1 trn1 nid2 trn2)
    interpret Sink1: Post_RECEIVER "UIDs nid1" PID AID .
    interpret Sink2: Post_RECEIVER "UIDs nid2" PID AID .
    show ?case using 8(2,4,6-10,11,12,13)
      apply (elim syncO_cases; cases trn1; cases trn2)
          apply (auto simp: Iss.g_simps ObservationSetup_RECEIVER.g_simps split: prod.splits)
      apply (auto simp: sendPost_def split: prod.splits elim: syncVE)[]
      done
next
  case (9 nid trn)
    then show ?case
      by (cases "(nid,trn)" rule: tgtNodeOf.cases)
         (auto simp: ObservationSetup_RECEIVER.γ.simps)
next
  case (10 nid trn) then show ?case by (cases trn) (auto simp: φ_defs)
next
  case (11 vSrc nid vn) then show ?case by (cases vSrc rule: value_cases) (auto simp: syncV_def)
next
  case (12 vSrc nid vn) then show ?case by (cases vSrc rule: value_cases) (auto simp: syncV_def)
qed

lemma list_all_Not_isl_projectSrcV: "list_all (Not o isl) (Net.projectSrcV aid vlSrc)"
proof (induction vlSrc)
  case (Cons vSrc vlSrc') then show ?case by (cases vSrc rule: value_cases) auto
qed auto

context
fixes AID' :: apiID
assumes AID': "AID' ∈ AIDs - {AID}"
begin

interpretation Recv: Post_RECEIVER "UIDs AID'" PID AID by unfold_locales

lemma Iss_BC_BO_tgtAPI:
shows "(Iss.BC vl vl1 ⟶ map Iss.tgtAPI (filter Iss.isPValS vl) =
                          map Iss.tgtAPI (filter Iss.isPValS vl1)) ∧
       (Iss.BO vl vl1 ⟶ map Iss.tgtAPI (filter Iss.isPValS vl) =
                          map Iss.tgtAPI (filter Iss.isPValS vl1))"
by (induction rule: Iss.BC_BO.induct) auto

lemma Iss_B_Recv_B_aux:
assumes "list_all isl vl"
and "list_all isl vl1"
and "map Iss.tgtAPI (filter Iss.isPValS (map projl vl)) =
     map Iss.tgtAPI (filter Iss.isPValS (map projl vl1))"
shows "length (map projr (Net.projectSrcV AID' vl)) = length (map projr (Net.projectSrcV AID' vl1))"
using assms proof (induction vl vl1 rule: list22_induct)
  case (ConsCons v vl v1 vl1)
    consider (SendSend) aid pst pst1 where "v = Inl (Iss.PValS aid pst)" "v1 = Inl (Iss.PValS aid pst1)"
           | (Internal) "comOfV AID v = Internal" "¬Iss.isPValS (projl v)"
           | (Internal1) "comOfV AID v1 = Internal" "¬Iss.isPValS (projl v1)"
      using ConsCons(4-6) by (cases v rule: value_cases; cases v1 rule: value_cases) auto
    then show ?case proof cases
      case (SendSend) then show ?thesis using ConsCons.IH(1) ConsCons.prems by auto
    next
      case (Internal) then show ?thesis using ConsCons.IH(2)[of "v1 # vl1"] ConsCons.prems by auto
    next
      case (Internal1) then show ?thesis using ConsCons.IH(3)[of "v # vl"] ConsCons.prems by auto
    qed
qed (auto simp: comOfV_AID)

lemma Iss_B_Recv_B:
assumes "B AID vl vl1"
shows "Recv.B (map projr (Net.projectSrcV AID' vl)) (map projr (Net.projectSrcV AID' vl1))"
using assms Iss_B_Recv_B_aux Iss_BC_BO_tgtAPI by (auto simp: Iss.B_def Recv.B_def)

end

lemma map_projl_Inl: "map (projl o Inl) vl = vl"
by (induction vl) auto

lemma these_map_Inl_projl: "list_all isl vl ⟹ these (map (Some o Inl o projl) vl) = vl"
by (induction vl) auto

lemma map_projr_Inr: "map (projr o Inr) vl = vl"
by (induction vl) auto

lemma these_map_Inr_projr: "list_all (Not o isl) vl ⟹ these (map (Some o Inr o projr) vl) = vl"
by (induction vl) auto

sublocale BD_Security_TS_Network_Preserve_Source_Security_getTgtV
where istate = "λ_. istate" and validTrans = validTrans and srcOf = "λ_. srcOf" and tgtOf = "λ_. tgtOf"
  and nodes = AIDs and comOf = comOf and tgtNodeOf = tgtNodeOf
  and sync = sync and φ = φ and f = f and γ = γ and g = g and T = T and B = B
  and comOfV = comOfV and tgtNodeOfV = tgtNodeOfV and syncV = syncV
  and comOfO = comOfO and tgtNodeOfO = tgtNodeOfO and syncO = syncO (*and cmpO = cmpO*)
  and source = AID and getTgtV = getTgtV
proof (unfold_locales, goal_cases)
  case 1 show ?case using AID_in_AIDs .
next
  case 2
    interpret Iss': BD_Security_TS_Trans
      istate System_Specification.validTrans srcOf tgtOf Iss.φ Iss.f Iss.γ Iss.g Iss.T Iss.B
      istate System_Specification.validTrans srcOf tgtOf Iss.φ "λtrn. Inl (Iss.f trn)" Iss.γ Iss.g Iss.T "B AID"
      id id Some "Some o Inl"
    proof (unfold_locales, goal_cases)
      case (11 vl' vl1' tr) then show ?case
        by (intro exI[of _ "map projl vl1'"]) (auto simp: map_projl_Inl these_map_Inl_projl)
    qed auto
    show ?case using Iss.secure Iss'.translate_secure by auto
next
  case (3 aid tr vl' vl1)
    then show ?case
      using Iss_B_Recv_B[of aid "(Net.lV AID tr)" vl1] list_all_Not_isl_projectSrcV
      by auto
qed

theorem secure: "secure"
proof (intro preserve_source_secure ballI)
  fix aid
  assume aid: "aid ∈ AIDs - {AID}"
  interpret Node: Post_RECEIVER "UIDs aid" PID AID .
  interpret Node': BD_Security_TS_Trans
    istate System_Specification.validTrans srcOf tgtOf Node.φ Node.f Node.γ Node.g Node.T Node.B
    istate System_Specification.validTrans srcOf tgtOf Node.φ "λtrn. Inr (Node.f trn)" Node.γ Node.g Node.T "B aid"
    id id Some "Some o Inr"
  proof (unfold_locales, goal_cases)
    case (11 vl' vl1' tr) then show ?case using aid
      by (intro exI[of _ "map projr vl1'"]) (auto simp: map_projr_Inr these_map_Inr_projr)
  qed auto
  show "Net.lsecure aid"
    using aid Node.Post_secure Node'.translate_secure by auto
qed

end  (* context Post_Network *)

end
_ISSUER

Theory Independent_Post_Observation_Setup_ISSUER

(* Strengthened observation setup, customized for post confidentiality *)
theory Independent_Post_Observation_Setup_ISSUER
  imports
    "../../Safety_Properties"
    "../Post_Observation_Setup_ISSUER"
begin

subsection ‹Variation with multiple independent secret posts›

text ‹This section formalizes the lifting of the confidentiality of one
given (arbitrary but fixed) post to the confidentiality of two posts of
arbitrary nodes of the network, as described in \cite[Appendix E]{cosmedis-SandP2017}.
›

subsubsection‹Issuer observation setup›

locale Strong_ObservationSetup_ISSUER = Fixed_UIDs + Fixed_PID
begin

(*  *)
fun γ :: "(state,act,out) trans ⇒ bool" where
"γ (Trans _ a _ _) ⟷
   (∃ uid. userOfA a = Some uid ∧ uid ∈ UIDs)
   ∨
   ― ‹Communication actions are considered to be observable in order to make the security
      properties compositional›
   (∃ca. a = COMact ca)
   ∨
   ― ‹The following actions are added to strengthen the observers in order to show that all
      posts ∗‹other than ‹PID›› are completely independent of ‹PID›;  the confidentiality of ‹PID›
      is protected even if the observers can see all updates to other posts (and actions
      contributing to the declassification triggers of those posts).›
   (∃uid p pid pst. a = Uact (uPost uid p pid pst) ∧ pid ≠ PID)
   ∨
   (∃uid p. a = Sact (sSys uid p))
   ∨
   (∃uid p uid' p'. a = Cact (cUser uid p uid' p'))
   ∨
   (∃uid p pid. a = Cact (cPost uid p pid))
   ∨
   (∃uid p uid'. a = Cact (cFriend uid p uid'))
   ∨
   (∃uid p uid'. a = Dact (dFriend uid p uid'))
   ∨
   (∃uid p pid v. a = Uact (uVisPost uid p pid v))"

(* Note: the passwords don't really have to be purged (since identity theft is not
considered in the first place); however, purging passwords looks more sane. *)

(* Purging the password in starting actions: *)
fun sPurge :: "sActt ⇒ sActt" where
"sPurge (sSys uid pwd) = sSys uid emptyPass"

(* Purging communicating actions: user-password information is removed.
  Note: comReceivePost is not affected by the purging, in that post text
  is not removed; this only happens on the receiving end.
  (Also, nothing to purge in comSendPost either -- the output will be purged here, since
   only the output contains an actual post.)


  Note: server-password info is not purged --todo: discuss this.  *)
fun comPurge :: "comActt ⇒ comActt" where
 "comPurge (comSendServerReq uID p aID reqInfo) = comSendServerReq uID emptyPass aID reqInfo"
|"comPurge (comConnectClient uID p aID sp) = comConnectClient uID emptyPass aID sp"
|"comPurge (comConnectServer aID sp) = comConnectServer aID sp"
|"comPurge (comSendPost uID p aID pID) = comSendPost uID emptyPass aID pID"
|"comPurge (comSendCreateOFriend uID p aID uID') = comSendCreateOFriend uID emptyPass aID uID'"
|"comPurge (comSendDeleteOFriend uID p aID uID') = comSendDeleteOFriend uID emptyPass aID uID'"
|"comPurge ca = ca"

(* Purging outputs: post text information for PID
  is removed from the only kind of output that may contain such info: outAIDPPIDNUID.
  (Again, server-password info is not purged.)   *)
fun outPurge :: "out ⇒ out" where
 "outPurge (O_sendPost (aID, sp, pID, pst, uID, vs)) =
  (let pst' = (if pID = PID then emptyPost else pst)
   in O_sendPost (aID, sp, pID, pst', uID, vs))"
|"outPurge ou = ou"

fun g :: "(state,act,out)trans ⇒ obs" where
 "g (Trans _ (Sact sa) ou _) = (Sact (sPurge sa), outPurge ou)"
|"g (Trans _ (COMact ca) ou _) = (COMact (comPurge ca), outPurge ou)"
|"g (Trans _ a ou _) = (a,ou)"

lemma comPurge_simps:
  "comPurge ca = comSendServerReq uID p aID reqInfo ⟷ (∃p'. ca = comSendServerReq uID p' aID reqInfo ∧ p = emptyPass)"
  "comPurge ca = comReceiveClientReq aID reqInfo ⟷ ca = comReceiveClientReq aID reqInfo"
  "comPurge ca = comConnectClient uID p aID sp ⟷ (∃p'. ca = comConnectClient uID p' aID sp ∧ p = emptyPass)"
  "comPurge ca = comConnectServer aID sp ⟷ ca = comConnectServer aID sp"
  "comPurge ca = comReceivePost aID sp nID nt uID v ⟷ ca = comReceivePost aID sp nID nt uID v"
  "comPurge ca = comSendPost uID p aID nID ⟷ (∃p'. ca = comSendPost uID p' aID nID ∧ p = emptyPass)"
  "comPurge ca = comSendCreateOFriend uID p aID uID' ⟷ (∃p'. ca = comSendCreateOFriend uID p' aID uID' ∧ p = emptyPass)"
  "comPurge ca = comReceiveCreateOFriend aID cp uID uID' ⟷ ca = comReceiveCreateOFriend aID cp uID uID'"
  "comPurge ca = comSendDeleteOFriend uID p aID uID' ⟷ (∃p'. ca = comSendDeleteOFriend uID p' aID uID' ∧ p = emptyPass)"
  "comPurge ca = comReceiveDeleteOFriend aID cp uID uID' ⟷ ca = comReceiveDeleteOFriend aID cp uID uID'"
by (cases ca; auto)+

lemma outPurge_simps[simp]:
  "outPurge ou = outErr ⟷ ou = outErr"
  "outPurge ou = outOK ⟷ ou = outOK"
  "outPurge ou = O_sendServerReq ossr ⟷ ou = O_sendServerReq ossr"
  "outPurge ou = O_connectClient occ ⟷ ou = O_connectClient occ"
  "outPurge ou = O_sendPost (aid, sp, pid, pst', uid, vs) ⟷ (∃pst.
     ou = O_sendPost (aid, sp, pid, pst, uid, vs) ∧
     pst' = (if pid = PID then emptyPost else pst))"
  "outPurge ou = O_sendCreateOFriend oscf ⟷ ou = O_sendCreateOFriend oscf"
  "outPurge ou = O_sendDeleteOFriend osdf ⟷ ou = O_sendDeleteOFriend osdf"
by (cases ou; auto simp: Strong_ObservationSetup_ISSUER.outPurge.simps)+


lemma g_simps:
  "g (Trans s a ou s') = (COMact (comSendServerReq uID p aID reqInfo), O_sendServerReq ossr)
⟷ (∃p'. a = COMact (comSendServerReq uID p' aID reqInfo) ∧ p = emptyPass ∧ ou = O_sendServerReq ossr)"
  "g (Trans s a ou s') = (COMact (comReceiveClientReq aID reqInfo), outOK)
⟷ a = COMact (comReceiveClientReq aID reqInfo) ∧ ou = outOK"
  "g (Trans s a ou s') = (COMact (comConnectClient uID p aID sp), O_connectClient occ)
⟷ (∃p'. a = COMact (comConnectClient uID p' aID sp) ∧ p = emptyPass ∧ ou = O_connectClient occ)"
  "g (Trans s a ou s') = (COMact (comConnectServer aID sp), outOK)
⟷ a = COMact (comConnectServer aID sp) ∧ ou = outOK"
  "g (Trans s a ou s') = (COMact (comReceivePost aID sp nID nt uID v), outOK)
⟷ a = COMact (comReceivePost aID sp nID nt uID v) ∧ ou = outOK"
  "g (Trans s a ou s') = (COMact (comSendPost uID p aID nID), O_sendPost (aid, sp, pid, pst', uid, vs))
⟷ (∃pst p'. a = COMact (comSendPost uID p' aID nID) ∧ p = emptyPass ∧ ou = O_sendPost (aid, sp, pid, pst, uid, vs) ∧ pst' = (if pid = PID then emptyPost else pst))"
  "g (Trans s a ou s') = (COMact (comSendCreateOFriend uID p aID uID'), O_sendCreateOFriend (aid, sp, uid, uid'))
⟷ (∃p'. a = (COMact (comSendCreateOFriend uID p' aID uID')) ∧ p = emptyPass ∧ ou = O_sendCreateOFriend (aid, sp, uid, uid'))"
  "g (Trans s a ou s') = (COMact (comReceiveCreateOFriend aID cp uID uID'), outOK)
⟷ a = COMact (comReceiveCreateOFriend aID cp uID uID') ∧ ou = outOK"
  "g (Trans s a ou s') = (COMact (comSendDeleteOFriend uID p aID uID'), O_sendDeleteOFriend (aid, sp, uid, uid'))
⟷ (∃p'. a = COMact (comSendDeleteOFriend uID p' aID uID') ∧ p = emptyPass ∧ ou = O_sendDeleteOFriend (aid, sp, uid, uid'))"
  "g (Trans s a ou s') = (COMact (comReceiveDeleteOFriend aID cp uID uID'), outOK)
⟷ a = COMact (comReceiveDeleteOFriend aID cp uID uID') ∧ ou = outOK"
by (cases a; auto simp: comPurge_simps)+

end

end
up_ISSUER

Theory Independent_DYNAMIC_Post_Value_Setup_ISSUER

(* The value setup for post confidentiality *)
theory Independent_DYNAMIC_Post_Value_Setup_ISSUER
  imports
    "../../Safety_Properties"
    "Independent_Post_Observation_Setup_ISSUER"
    "../Post_Unwinding_Helper_ISSUER"
begin

subsubsection ‹Issuer value setup›

locale Post = Strong_ObservationSetup_ISSUER
begin

datatype "value" =
  isPVal: PVal post ― ‹updating the post content locally›
| isPValS: PValS (tgtAPI: apiID) post ― ‹sending the post to another node›
| isOVal: OVal bool ― ‹change in the dynamic declassification trigger condition›

definition "open" where
"open s ≡
 ∃ uid ∈ UIDs.
   uid ∈∈ userIDs s ∧ PID ∈∈ postIDs s ∧
   (uid = admin s ∨ uid = owner s PID ∨ uid ∈∈ friendIDs s (owner s PID) ∨
    vis s PID = PublicV)"

sublocale Issuer_State_Equivalence_Up_To_PID .

lemma eqButPID_open:
assumes "eqButPID s s1"
shows "open s ⟷ open s1"
using eqButPID_stateSelectors[OF assms] (* eqButPID_postSelectors[OF assms] *)
unfolding open_def by auto

lemma not_open_eqButPID:
assumes 1: "¬ open s" and 2: "eqButPID s s1"
shows "¬ open s1"
using 1 unfolding eqButPID_open[OF 2] .

lemma step_isCOMact_open:
assumes "step s a = (ou, s')"
and "isCOMact a"
shows "open s' = open s"
using assms proof (cases a)
  case (COMact ca) then show ?thesis using assms by (cases ca) (auto simp: open_def com_defs)
qed auto

lemma validTrans_isCOMact_open:
assumes "validTrans trn"
and "isCOMact (actOf trn)"
shows "open (tgtOf trn) = open (srcOf trn)"
using assms step_isCOMact_open by (cases trn) auto

lemma list_all_isOVal_filter_isPValS:
"list_all isOVal vl ⟹ filter (Not o isPValS) vl = vl"
by (induct vl) auto

lemma list_all_Not_isOVal_OVal_True:
assumes "list_all (Not ∘ isOVal) ul"
and "ul @ vll = OVal True # vll'"
shows "ul = []"
using assms by (cases ul) auto

lemma list_all_filter_isOVal_isPVal_isPValS:
assumes "list_all (Not ∘ isOVal) ul"
and "filter isPValS ul = []" and "filter isPVal ul = []"
shows "ul = []"
using assms value.exhaust_disc by (induct ul) auto

lemma filter_list_all_isPValS_isOVal:
assumes "list_all (Not ∘ isOVal) ul" and "filter isPVal ul = []"
shows "list_all isPValS ul"
using assms value.exhaust_disc by (induct ul) auto

lemma filter_list_all_isPVal_isOVal:
assumes "list_all (Not ∘ isOVal) ul" and "filter isPValS ul = []"
shows "list_all isPVal ul"
using assms value.exhaust_disc by (induct ul) auto

lemma list_all_isPValS_Not_isOVal_filter:
assumes "list_all isPValS ul" shows "list_all (Not ∘ isOVal) ul ∧ filter isPVal ul = []"
using assms value.exhaust_disc by (induct ul) auto

lemma filter_isTValS_Nil:
"filter isPValS vl = [] ⟷
 list_all (λ v. isPVal v ∨ isOVal v) vl"
proof(induct vl)
  case (Cons v vl)
  thus ?case by (cases v) auto
qed auto

(*   ******  *)
fun φ :: "(state,act,out) trans ⇒ bool" where
"φ (Trans _ (Uact (uPost uid p pid pst)) ou _) = (pid = PID ∧ ou = outOK)"
|
"φ (Trans _ (COMact (comSendPost uid p aid pid)) ou _) = (pid = PID ∧ ou ≠ outErr)"
(* Added during strengthening: saying ≠ outErr is simpler than actually describing the output, which essentially
   takes some parameters from the post and some values from the state. *)
|
"φ (Trans s _ _ s') = (open s ≠ open s')"

lemma φ_def1:
"φ trn ⟷
 (∃uid p pst. actOf trn = Uact (uPost uid p PID pst) ∧ outOf trn = outOK) ∨
 (∃uid p aid. actOf trn = COMact (comSendPost uid p aid PID) ∧ outOf trn ≠ outErr) ∨
 ((∀uid p pid pst. actOf trn ≠ Uact (uPost uid p pid pst)) ∧
  (∀uid p aid pid. actOf trn ≠ COMact (comSendPost uid p aid pid)) ∧
   open (srcOf trn) ≠ open (tgtOf trn))"
by (cases trn rule: φ.cases) auto

lemma φ_def2:
assumes "step s a = (ou,s')"
shows
"φ (Trans s a ou s') ⟷
 (∃uid p pst. a = Uact (uPost uid p PID pst) ∧ ou = outOK) ∨
 (∃uid p aid. a = COMact (comSendPost uid p aid PID) ∧ ou ≠ outErr) ∨
  open s ≠ open s'"
using assms
by (cases "Trans s a ou s'" rule: φ.cases) (auto simp: all_defs open_def)

lemma uTextPost_out:
assumes 1: "step s a = (ou,s')" and a: "a = Uact (uPost uid p PID pst)" and 2: "ou = outOK"
shows "uid = owner s PID ∧ p = pass s uid"
using 1 2 unfolding a by (auto simp: u_defs)

lemma comSendPost_out:
assumes 1: "step s a = (ou,s')" and a: "a = COMact (comSendPost uid p aid PID)"
  and 2: "ou ≠ outErr"
shows "ou = O_sendPost (aid, clientPass s aid, PID, post s PID, owner s PID, vis s PID)
       ∧ uid = admin s ∧ p = pass s (admin s)"
using 1 2 unfolding a by (auto simp: com_defs)

lemma step_open_isCOMact:
assumes "step s a = (ou,s')"
and "open s ≠ open s'"
shows "¬ isCOMact a ∧ ¬ (∃ ua. isuPost ua ∧ a = Uact ua)"
  using assms unfolding open_def
  apply(cases a)
  subgoal by (auto simp: all_defs)
  subgoal by (auto simp: all_defs)
  subgoal by (auto simp: all_defs)
  subgoal for x4 by (cases x4) (auto simp: all_defs)
  subgoal by (auto simp: all_defs)
  subgoal by (auto simp: all_defs)
  subgoal for x7 by (cases x7) (auto simp: all_defs)
  done

lemma φ_def3:
assumes "step s a = (ou,s')"
shows
"φ (Trans s a ou s') ⟷
 (∃pst. a = Uact (uPost (owner s PID) (pass s (owner s PID)) PID pst) ∧ ou = outOK)
 ∨
 (∃aid. a = COMact (comSendPost (admin s) (pass s (admin s)) aid PID) ∧
        ou = O_sendPost (aid, clientPass s aid, PID, post s PID, owner s PID, vis s PID))
 ∨
 open s ≠ open s' ∧ ¬ isCOMact a ∧ ¬ (∃ ua. isuPost ua ∧ a = Uact ua)"
unfolding φ_def2[OF assms]
using comSendPost_out[OF assms] uTextPost_out[OF assms]
step_open_isCOMact[OF assms]
by blast

fun f :: "(state,act,out) trans ⇒ value" where
"f (Trans s (Uact (uPost uid p pid pst)) _ s') =
 (if pid = PID then PVal pst else OVal (open s'))"  (* else undefined  *)
|
"f (Trans s (COMact (comSendPost uid p aid pid)) (O_sendPost (_, _, _, pst, _)) s') =
 (if pid = PID then PValS aid pst else OVal (open s'))" (* else undefined  *)
|
"f (Trans s _ _ s') = OVal (open s')"

lemma f_open_OVal:
assumes "step s a = (ou,s')"
and "open s ≠ open s' ∧ ¬ isCOMact a ∧ ¬ (∃ ua. isuPost ua ∧ a = Uact ua)"
shows "f (Trans s a ou s') = OVal (open s')"
using assms by (cases "Trans s a ou s'" rule: f.cases) auto

lemma f_eq_PVal:
assumes "step s a = (ou,s')" and "φ (Trans s a ou s')"
and "f (Trans s a ou s') = PVal pst"
shows "a = Uact (uPost (owner s PID) (pass s (owner s PID)) PID pst)"
using assms by (cases "Trans s a ou s'" rule: f.cases) (auto simp: u_defs com_defs)

lemma f_eq_PValS:
assumes "step s a = (ou,s')" and "φ (Trans s a ou s')"
and "f (Trans s a ou s') = PValS aid pst"
shows "a = COMact (comSendPost (admin s) (pass s (admin s)) aid PID)"
using assms by (cases "Trans s a ou s'" rule: f.cases) (auto simp: com_defs)

lemma f_eq_OVal:
assumes "step s a = (ou,s')" and "φ (Trans s a ou s')"
and "f (Trans s a ou s') = OVal b"
shows "open s' ≠ open s"
using assms by (auto simp: φ_def2 com_defs)

lemma uPost_comSendPost_open_eq:
assumes step: "step s a = (ou, s')"
and a: "a = Uact (uPost uid p pid pst) ∨ a = COMact (comSendPost uid p aid pid)"
shows "open s' = open s"
using assms a unfolding open_def
by (cases a) (auto simp: u_defs com_defs)

lemma step_open_φ_f_PVal_γ:
assumes s: "reach s"
and step: "step s a = (ou, s')"
and PID: "PID ∈ set (postIDs s)"
and op: "¬ open s" and fi: "φ (Trans s a ou s')" and f: "f (Trans s a ou s') = PVal pst"
shows "¬ γ (Trans s a ou s')"
proof-
  have a: "a = Uact (uPost (owner s PID) (pass s (owner s PID)) PID pst)"
  using f_eq_PVal[OF step fi f] .
  have ou: "ou = outOK" using fi op unfolding a φ_def2[OF step] by auto
  have "owner s PID ∈∈ userIDs s" using s by (simp add: PID reach_owner_userIDs)
  hence "owner s PID ∉ UIDs" using op PID unfolding open_def by auto
  thus ?thesis unfolding a by simp
qed

lemma Uact_uPaperC_step_eqButPID:
assumes a: "a = Uact (uPost uid p PID pst)"
and "step s a = (ou,s')"
shows "eqButPID s s'"
using assms unfolding eqButPID_def eeqButPID_def eeqButPID_F_def
by (auto simp: all_defs split: if_splits)

lemma eqButPID_step_φ_imp:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and φ: "φ (Trans s a ou s')"
shows "φ (Trans s1 a ou1 s1')"
proof-
  have s's1': "eqButPID s' s1'"
  using eqButPID_step local.step ss1 step1 by blast
  show ?thesis using step step1 φ eqButPID_open[OF ss1] eqButPID_open[OF s's1']
  using eqButPID_stateSelectors[OF ss1]
  unfolding φ_def2[OF step] φ_def2[OF step1]
  by (auto simp: all_defs)
qed

lemma eqButPID_step_φ:
assumes s's1': "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
shows "φ (Trans s a ou s') = φ (Trans s1 a ou1 s1')"
by (metis eqButPID_step_φ_imp eqButPID_sym assms)


end



end
itle>

Theory Independent_DYNAMIC_Post_ISSUER

theory Independent_DYNAMIC_Post_ISSUER
  imports
    "Independent_Post_Observation_Setup_ISSUER"
    "Independent_DYNAMIC_Post_Value_Setup_ISSUER"
    "Bounded_Deducibility_Security.Compositional_Reasoning"
begin


subsubsection ‹Issuer declassification bound›

(* We verify that a group of users,
   allowed to take normal actions to the system and observe their outputs
   *and additionally allowed to observe communication*,
   learn nothing about the updates to a post and the sends of that post to other APIs
   beyond:
(1) the updates that occur during the times when:
     -- either a user in the group is the post's owner
     -- or a user in the group is a friend of the owner
     -- or the group has at least one registered user and the post is marked "public"
(2) the presence of the sends (i.e., the number of the sending actions)
(3) and the public knowledge that what is being sent is always the last version (modeled as
the correlation predicate)
*)

context Post
begin

fun T :: "(state,act,out) trans ⇒ bool" where "T _ = False"

text ‹We again use the dynamic declassification bound for the issuer node
(Section~\ref{sec:dynamic-post-issuer}).›

inductive BC :: "value list ⇒ value list ⇒ bool"
and BO :: "value list ⇒ value list ⇒ bool"
where
 BC_PVal[simp,intro!]:
  "list_all (Not o isOVal) ul ⟹ list_all (Not o isOVal) ul1 ⟹
   map tgtAPI (filter isPValS ul) = map tgtAPI (filter isPValS ul1) ⟹
   (ul = [] ⟶ ul1 = [])
   ⟹ BC ul ul1"
|BC_BO[intro]:
  "BO vl vl1 ⟹
   list_all (Not o isOVal) ul ⟹ list_all (Not o isOVal) ul1 ⟹
   map tgtAPI (filter isPValS ul) = map tgtAPI (filter isPValS ul1) ⟹
   (ul = [] ⟷ ul1 = []) ⟹
   (ul ≠ [] ⟹ isPVal (last ul) ∧ last ul = last ul1) ⟹
   list_all isPValS sul
   ⟹
   BC (ul  @ sul @ OVal True # vl)
      (ul1 @ sul @ OVal True # vl1)"
(*  *)
|BO_PVal[simp,intro!]:
  "list_all (Not o isOVal) ul ⟹ BO ul ul"
|BO_BC[intro]:
  "BC vl vl1 ⟹
   list_all (Not o isOVal) ul
   ⟹
   BO (ul @ OVal False # vl) (ul @ OVal False # vl1)"

lemma list_all_filter_Not_isOVal:
assumes "list_all (Not ∘ isOVal) ul"
and "filter isPValS ul = []" and "filter isPVal ul = []"
shows "ul = []"
using assms value.exhaust_disc by (induct ul) auto

lemma BC_not_Nil: "BC vl vl1 ⟹ vl = [] ⟹ vl1 = []"
by(auto elim: BC.cases)

lemma BC_OVal_True:
assumes "BC (OVal True # vl') vl1"
shows "∃ vl1'. BO vl' vl1' ∧ vl1 = OVal True # vl1'"
proof-
  define vl where vl: "vl ≡ OVal True # vl'"
  have "BC vl vl1" using assms unfolding vl by auto
  thus ?thesis proof cases
    case (BC_BO vll vll1 ul ul1 sul)
    hence ul: "ul = []" unfolding vl apply simp
    by (metis (no_types) Post.value.disc(9) append_eq_Cons_conv
         list.map(2) list.pred_inject(2) list_all_map)
    have sul: "sul = []" using BC_BO unfolding vl ul apply simp
    by (metis Post.value.disc(6) append_eq_Cons_conv list.pred_inject(2))
    show ?thesis
    apply - apply(rule exI[of _ "vll1"])
    using BC_BO using list_all_filter_Not_isOVal[of ul1]
    unfolding ul sul vl by auto
  qed(unfold vl, auto)
qed

(* Correlation is defined to mean: always send what was last uploaded, or emptyPost
if nothing had been uploaded. This needs the auxiliary notion of "coherence from" *)
fun corrFrom :: "post ⇒ value list ⇒ bool" where
 "corrFrom pst [] = True"
|"corrFrom pst (PVal pstt # vl) = corrFrom pstt vl"
|"corrFrom pst (PValS aid pstt # vl) = (pst = pstt ∧ corrFrom pst vl)"
|"corrFrom pst (OVal b # vl) = (corrFrom pst vl)"


abbreviation corr :: "value list ⇒ bool" where "corr ≡ corrFrom emptyPost"

definition B where
"B vl vl1 ≡ BC vl vl1 ∧ corr vl1"

(* lemma vl_Nil_filter_not:
assumes "filter (%v. isPVal v ∨ isOVal v) Vl = [] ∧ filter (Not o isPVal) Vl = []"
shows "Vl = []"
using assms by (induct Vl) auto *)

lemma B_not_Nil:
assumes B: "B vl vl1" and vl: "vl = []"
shows "vl1 = []"
using B Post.BC_not_Nil Post.B_def vl by blast


sublocale BD_Security_IO where
istate = istate and step = step and
φ = φ and f = f and γ = γ and g = g and T = T and B = B
done

subsubsection ‹Issuer unwinding proof›

lemma reach_PublicV_imples_FriendV[simp]:
assumes "reach s"
and "vis s pid ≠ PublicV"
shows "vis s pid = FriendV"
using assms reach_vis by auto


(* major *) lemma eqButPID_step_γ_out:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and op: "¬ open s"
and sT: "reachNT s" and s1: "reach s1"
and γ: "γ (Trans s a ou s')"
shows "(∃ uid p aid pid. a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
       ou = ou1"
proof-
  note [simp] = all_defs
                open_def
  note s = reachNT_reach[OF sT]
  note willUse =
  step step1 γ
  not_open_eqButPID[OF op ss1]
  reach_vis[OF s]
  eqButPID_stateSelectors[OF ss1] (* eqButPID_postSelectors[OF ss1]  *)
  eqButPID_actions[OF ss1]
  eqButPID_update[OF ss1] (* eqButPID_setTextPost[OF ss1] *) eqButPID_not_PID[OF ss1]
(* added to cope with extra leak towards the admin, when moving from CoSMed to CoSMeDis: *)
  (* eqButPID_eqButT[OF ss1] *) eqButPID_eqButF[OF ss1]
  eqButPID_setShared[OF ss1] eqButPID_updateShared[OF ss1]
  eeqButPID_F_not_PID eqButPID_not_PID_sharedWith
  eqButPID_insert2[OF ss1]
  show ?thesis
  proof (cases a)
    case (Sact x1)
    with willUse show ?thesis by (cases x1) auto
  next
    case (Cact x2)
    with willUse show ?thesis by (cases x2) auto
  next
    case (Dact x3)
    with willUse show ?thesis by (cases x3) auto
  next
    case (Uact x4)
    with willUse show ?thesis by (cases x4) auto
  next
    case (Ract x5)
    with willUse show ?thesis
    proof (cases x5)
      case (rPost uid p pid)
      with Ract willUse show ?thesis by (cases "pid = PID") auto
    qed auto
  next
    case (Lact x6)
    with willUse show ?thesis
    proof (cases x6)
      case (lClientsPost uid p pid)
      with Lact willUse show ?thesis by (cases "pid = PID") auto
    qed auto
  next
    case (COMact x7)
    with willUse show ?thesis by (cases x7) auto
  qed
qed

(* major *) lemma eqButPID_step_eq:
assumes ss1: "eqButPID s s1"
and a: "a = Uact (uPost uid p PID pst)" "ou = outOK"
and step: "step s a = (ou, s')" and step1: "step s1 a = (ou', s1')"
shows "s' = s1'"
using ss1 step step1
using eqButPID_stateSelectors[OF ss1]
eqButPID_update[OF ss1] (* eqButPID_setTextPost[OF ss1] *) eqButPID_setShared[OF ss1]
unfolding a by (auto simp: u_defs)


definition Δ0 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ0 s vl s1 vl1 ≡
 ¬ PID ∈∈ postIDs s ∧
 s = s1 ∧ BC vl vl1 ∧
 corr vl1"

definition Δ1 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ1 s vl s1 vl1 ≡
 PID ∈∈ postIDs s ∧
 list_all (Not o isOVal) vl ∧ list_all (Not o isOVal) vl1 ∧
 map tgtAPI (filter isPValS vl) = map tgtAPI (filter isPValS vl1) ∧
 (vl = [] ⟶ vl1 = []) ∧
 eqButPID s s1 ∧ ¬ open s ∧
 corrFrom (post s1 PID) vl1"

definition Δ11 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ11 s vl s1 vl1 ≡
 PID ∈∈ postIDs s ∧
 vl = [] ∧ list_all isPVal vl1 ∧
 eqButPID s s1 ∧ ¬ open s ∧
 corrFrom (post s1 PID) vl1"

definition Δ2 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ2 s vl s1 vl1 ≡
 PID ∈∈ postIDs s ∧
 list_all (Not o isOVal) vl ∧
 vl = vl1 ∧
 s = s1 ∧ open s ∧
 corrFrom (post s1 PID) vl1"

definition Δ31 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ31 s vl s1 vl1 ≡
 PID ∈∈ postIDs s ∧
 (∃ ul ul1 sul vll vll1.
    BO vll vll1 ∧
    list_all (Not o isOVal) ul ∧ list_all (Not o isOVal) ul1 ∧
    map tgtAPI (filter isPValS ul) = map tgtAPI (filter isPValS ul1) ∧
    ul ≠ [] ∧ ul1 ≠ [] ∧
    isPVal (last ul) ∧ last ul = last ul1 ∧
    list_all isPValS sul ∧
    vl = ul @ sul @ OVal True # vll ∧ vl1 = ul1 @ sul @ OVal True # vll1) ∧
 eqButPID s s1 ∧ ¬ open s ∧
 corrFrom (post s1 PID) vl1"

definition Δ32 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ32 s vl s1 vl1 ≡
 PID ∈∈ postIDs s ∧
 (∃ sul vll vll1.
    BO vll vll1 ∧
    list_all isPValS sul ∧
    vl = sul @ OVal True # vll ∧ vl1 = sul @ OVal True # vll1) ∧
 s = s1 ∧ ¬ open s ∧
 corrFrom (post s1 PID) vl1"

definition Δ4 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ4 s vl s1 vl1 ≡
 PID ∈∈ postIDs s ∧
 (∃ ul vll vll1.
    BC vll vll1 ∧
    list_all (Not o isOVal) ul ∧
    vl = ul @ OVal False # vll ∧ vl1 = ul @ OVal False # vll1) ∧
 s = s1 ∧ open s ∧
 corrFrom (post s1 PID) vl1"

lemma istate_Δ0:
assumes B: "B vl vl1"
shows "Δ0 istate vl istate vl1"
using assms unfolding Δ0_def istate_def B_def by auto
(* by (auto simp: list_all_isOVal_filter_isPValS)
(auto intro!: exI[of _ "[]"]) *)

lemma list_all_filter[simp]:
assumes "list_all PP xs"
shows "filter PP xs = xs"
using assms by (induct xs) auto

lemma unwind_cont_Δ0: "unwind_cont Δ0 {Δ0,Δ1,Δ2,Δ31,Δ32,Δ4}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ0 s vl s1 vl1 ∨
                           Δ1 s vl s1 vl1 ∨ Δ2 s vl s1 vl1 ∨
                           Δ31 s vl s1 vl1 ∨ Δ32 s vl s1 vl1 ∨ Δ4 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ0 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s" and BC: "BC vl vl1" and PID: "¬ PID ∈∈ postIDs s"
  and cor1: "corr vl1" using reachNT_reach unfolding Δ0_def by auto
  have vis: "vis s PID = FriendV" using reach_not_postIDs_friendV[OF rs PID] .
  have pPID: "post s1 PID = emptyPost" by (simp add: PID reach_not_postIDs_emptyPost rs ss1)
  have vlvl1: "vl = [] ⟹ vl1 = []" using BC_not_Nil BC by auto
  have op: "¬ open s" using PID unfolding open_def by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      hence pPID': "post s' PID = emptyPost" using step pPID ss1 PID
        apply (cases a)
        subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
        subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
        subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
        subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
        subgoal by auto
        subgoal by auto
        subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
        done
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof-
        have ?match
        proof(cases "∃ uid p. a = Cact (cPost uid p PID) ∧ ou = outOK")
          case True
          then obtain uid p where a: "a = Cact (cPost uid p PID)" and ou: "ou = outOK" by auto
          have PID': "PID ∈∈ postIDs s'"
          using step PID unfolding a ou by (auto simp: c_defs)
          show ?thesis proof(cases
             "∃ uid' ∈ UIDs. uid' ∈∈ userIDs s ∧
                             (uid' = admin s ∨ uid' = uid ∨ uid' ∈∈ friendIDs s uid)")
            case True note uid = True
            have op': "open s'" using uid using step PID' unfolding a ou by (auto simp: c_defs open_def)
            have φ: "φ ?trn" using op op' unfolding φ_def2[OF step] by simp
            then obtain v where vl: "vl = v # vl'" and f: "f ?trn = v"
            using c unfolding consume_def φ_def2 by(cases vl) auto
            have v: "v = OVal True" using f op op' unfolding a by simp
            then obtain ul1 vl1' where BO': "BO vl' vl1'" and vl1: "vl1 = ul1 @ OVal True # vl1'"
            and ul1: "list_all (Not ∘ isOVal) ul1"
            using BC_OVal_True[OF BC[unfolded vl v]] by auto
            have ul1: "ul1 = []"
              using BC BC_OVal_True list_all_Not_isOVal_OVal_True ul1 v vl vl1 by blast
            hence vl1: "vl1 = OVal True # vl1'" using vl1 by simp
            show ?thesis proof
              show "validTrans ?trn1" unfolding ss1 using step by simp
            next
              show "consume ?trn1 vl1 vl1'" using φ f unfolding vl1 v consume_def ss1 by simp
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              show "?Δ s' vl' s' vl1'" using BO' proof(cases rule: BO.cases)
                case (BO_PVal)
                hence "Δ2 s' vl' s' vl1'" using PID' op' cor1 unfolding Δ2_def vl1 pPID' by auto
                thus ?thesis by simp
              next
                case (BO_BC vll vll1 textl)
                hence "Δ4 s' vl' s' vl1'" using PID' op' cor1 unfolding Δ4_def vl1 pPID' by auto
                thus ?thesis by simp
              qed
            qed
          next
            case False note uid = False
            have op': "¬ open s'" using step op uid vis unfolding open_def a by (auto simp: c_defs)
            have φ: "¬ φ ?trn" using op op' a unfolding φ_def2[OF step] by auto
            hence vl': "vl' = vl" using c unfolding consume_def by simp
            show ?thesis proof
              show "validTrans ?trn1" unfolding ss1 using step by simp
            next
              show "consume ?trn1 vl1 vl1" using φ unfolding consume_def ss1 by auto
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              show "?Δ s' vl' s' vl1" using BC proof(cases rule: BC.cases)
                case (BC_PVal)
                hence "Δ1 s' vl' s' vl1" using PID' op' cor1 unfolding Δ1_def vl' pPID' by auto
                thus ?thesis by simp
              next
                case (BC_BO vll vll1 ul ul1 sul)
                show ?thesis
                proof(cases "ul ≠ [] ∧ ul1 ≠ []")
                  case True
                  hence "Δ31 s' vl' s' vl1" using BC_BO PID' op' cor1
                  unfolding Δ31_def vl' pPID' apply auto
                  apply (rule exI[of _ "ul"]) apply (rule exI[of _ "ul1"])
                  apply (rule exI[of _ "sul"])
                  apply (rule exI[of _ "vll"]) apply (rule exI[of _ "vll1"])
                  by auto
                  thus ?thesis by simp
                next
                  case False
                  hence 0: "ul = [] ∧ ul1 = []" using BC_BO by simp
                  hence 1: "list_all isPValS ul ∧ list_all isPValS ul1"
                  using ‹list_all (Not ∘ isOVal) ul› ‹list_all (Not ∘ isOVal) ul1›
                  using filter_list_all_isPValS_isOVal by auto
                  (* have "map tgtAPI ul = map tgtAPI ul1" using 1BC_BO by auto *)
                  have "Δ32 s' vl' s' vl1" using BC_BO PID' op' cor1 0 1
                  unfolding Δ32_def vl' pPID' apply simp
                  apply(rule exI[of _ "sul"])
                  apply(rule exI[of _ vll]) apply(rule exI[of _ vll1])
                  by auto
                  thus ?thesis by simp
                qed
              qed
            qed
          qed
        next
          case False note a = False
          have op': "¬ open s'"
            using a step PID op unfolding open_def
            apply(cases a)
            subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
            subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
            subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
            subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
            subgoal by auto
            subgoal by auto
            subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
            done
          have φ: "¬ φ ?trn" using PID step op op' unfolding φ_def2[OF step]
          by (auto simp: u_defs com_defs)
          hence vl': "vl' = vl" using c unfolding consume_def by simp
          have PID': "¬ PID ∈∈ postIDs s'"
            using step PID a
            apply(cases a)
            subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
            subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
            subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
            subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
            subgoal by auto
            subgoal by auto
            subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
            done
          show ?thesis proof
            show "validTrans ?trn1" unfolding ss1 using step by simp
          next
            show "consume ?trn1 vl1 vl1" using φ unfolding consume_def ss1 by auto
          next
            show "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            have "Δ0 s' vl' s' vl1" using a BC PID' cor1 unfolding Δ0_def vl' by simp
            thus "?Δ s' vl' s' vl1" by simp
          qed
        qed
        thus ?thesis by simp
      qed
    qed
  thus ?thesis using vlvl1 by simp
  qed
qed

lemma unwind_cont_Δ1: "unwind_cont Δ1 {Δ1,Δ11}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ1 s vl s1 vl1 ∨ Δ11 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ1 s vl s1 vl1"
  then obtain
  lvl: "list_all (Not ∘ isOVal) vl" and lvl1: "list_all (Not ∘ isOVal) vl1"
  and map: "map tgtAPI (filter isPValS vl) = map tgtAPI (filter isPValS vl1)"
  and rs: "reach s" and ss1: "eqButPID s s1" and op: "¬ open s" and PID: "PID ∈∈ postIDs s"
  and vlvl1: "vl = [] ⟹ vl1 = []" and cor1: "corrFrom (post s1 PID) vl1"
  using reachNT_reach unfolding Δ1_def by auto
  have PID1: "PID ∈∈ postIDs s1" using eqButPID_stateSelectors[OF ss1] PID by auto
  have own: "owner s PID ∈ set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  hence own1: "owner s1 PID ∈ set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  have adm: "admin s ∈ set (userIDs s)" using reach_admin_userIDs[OF rs own] .
  hence adm1: "admin s1 ∈ set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  have op1: "¬ open s1" using op ss1 eqButPID_open by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof(cases vl1)
    case (Cons v1 vll1) note vl1 = Cons
    show ?thesis proof(cases v1)
      case (PVal pst1) note v1 = PVal
      define uid where uid: "uid ≡ owner s PID"  define p where p: "p ≡ pass s uid"
      define a1 where a1: "a1 ≡ Uact (uPost uid p PID pst1)"
      have uid1: "uid = owner s1 PID" and p1: "p = pass s1 uid" unfolding uid p
      using eqButPID_stateSelectors[OF ss1] by auto
      obtain ou1 s1' where step1: "step s1 a1 = (ou1, s1')" by(cases "step s1 a1") auto
      have ou1: "ou1 = outOK" using step1 PID1 own1 unfolding a1 uid1 p1 by (auto simp: u_defs)
      have op1': "¬ open s1'" using step1 op1 unfolding a1 ou1 open_def by (auto simp: u_defs)
      have uid: "uid ∉ UIDs" unfolding uid using op PID own unfolding open_def by auto
      have pPID1': "post s1' PID = pst1" using step1 unfolding a1 ou1 by (auto simp: u_defs)
      let ?trn1 = "Trans s1 a1 ou1 s1'"
      have ?iact proof
        show "step s1 a1 = (ou1, s1')" using step1 .
      next
        show φ: "φ ?trn1" unfolding φ_def2[OF step1] a1 ou1 by simp
        show "consume ?trn1 vl1 vll1"
        using φ unfolding vl1 consume_def v1 a1 by auto
      next
        show "¬ γ ?trn1" using uid unfolding a1 by auto
      next
        have "eqButPID s1 s1'" using Uact_uPaperC_step_eqButPID[OF _ step1] a1 by auto
        hence ss1': "eqButPID s s1'" using eqButPID_trans ss1 by blast
        show "?Δ s vl s1' vll1" using PID op ss1' lvl lvl1 map vlvl1 cor1
        unfolding Δ1_def vl1 v1 pPID1' by auto
      qed
      thus ?thesis by simp
    next
      case (PValS aid1 pst1) note v1 = PValS
      have pPID1: "post s1 PID = pst1" using cor1 unfolding vl1 v1 by auto
      then obtain v vll where vl: "vl = v # vll"
      using map unfolding vl1 v1 by (cases vl) auto
      have ?react proof
        fix a :: act and ou :: out and s' :: state and vl'
        let ?trn = "Trans s a ou s'"
        assume step: "step s a = (ou, s')" and c: "consume ?trn vl vl'"
        have PID': "PID ∈∈ postIDs s'" using reach_postIDs_persist[OF PID step] .
        obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
        let ?trn1 = "Trans s1 a ou1 s1'"
        show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'"
            (is "?match ∨ ?ignore")
        proof(cases "φ ?trn")
          case True note φ = True
          then obtain f: "f ?trn = v" and vl': "vl' = vll"
          using c unfolding vl consume_def φ_def2 by auto
          show ?thesis
          proof(cases v)
            case (PVal pst) note v = PVal
            have vll: "vll ≠ []" using map unfolding vl1 v1 vl v by auto
            define uid where uid: "uid ≡ owner s PID"  define p where p: "p ≡ pass s uid"
            have a: "a = Uact (uPost uid p PID pst)"
            using f_eq_PVal[OF step φ f[unfolded v]] unfolding uid p .
            have "eqButPID s s'" using Uact_uPaperC_step_eqButPID[OF a step] by auto
            hence s's1: "eqButPID s' s1" using eqButPID_sym eqButPID_trans ss1 by blast
            have op': "¬ open s'" using uPost_comSendPost_open_eq[OF step] a op by auto
            have ?ignore proof
              show γ: "¬ γ ?trn" using step_open_φ_f_PVal_γ[OF rs step PID op φ f[unfolded v]] .
              show "?Δ s' vl' s1 vl1"
              using lvl1 lvl PID' map s's1 op' vll cor1 unfolding Δ1_def vl1 vl vl' v
              by auto
            qed
            thus ?thesis by simp
          next
            case (PValS aid pst) note v = PValS
            define uid where uid: "uid ≡ admin s" define p where p: "p ≡ pass s uid"
            have a: "a = COMact (comSendPost (admin s) p aid PID)"
            using f_eq_PValS[OF step φ f[unfolded v]] unfolding uid p .
            have op': "¬ open s'" using uPost_comSendPost_open_eq[OF step] a op by auto
            have aid1: "aid1 = aid" using map unfolding vl1 v1 vl v by simp
            have uid1: "uid = admin s1" and p1: "p = pass s1 uid" unfolding uid p
            using eqButPID_stateSelectors[OF ss1] by auto
            obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
            have pPID1': "post s1' PID = pst1" using pPID1 step1 unfolding a
            by (auto simp: com_defs)
            have uid: "uid ∉ UIDs" unfolding uid using op PID adm unfolding open_def by auto
            have op1': "¬ open s1'" using step1 op1 unfolding a open_def
            by (auto simp: u_defs com_defs)
            let ?trn1 = "Trans s1 a ou1 s1'"
            have φ1: "φ ?trn1" using eqButPID_step_φ_imp[OF ss1 step step1 φ] .
            have ou1: "ou1 =
                O_sendPost (aid, clientPass s1 aid, PID, post s1 PID, owner s1 PID, vis s1 PID)"
              using φ1 step1 adm1 PID1 unfolding a by (cases ou1, auto simp: com_defs)
            have f1: "f ?trn1 = v1" using φ1 unfolding φ_def2[OF step1] v1 a ou1 aid1 pPID1 by auto
            have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
            have ?match proof
              show "validTrans ?trn1" using step1 by simp
            next
              show "consume ?trn1 vl1 vll1" using φ1 unfolding consume_def vl1 f1 by simp
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" note γ = this
              have ou: "(∃ uid p aid pid.
                       a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                                        ou = ou1"
              using eqButPID_step_γ_out[OF ss1 step step1 op rsT rs1 γ] .
              thus "g ?trn = g ?trn1" by (cases a) auto
            next
              show "?Δ s' vl' s1' vll1"
              proof(cases "vll = []")
                case True note vll = True
                hence "filter isPValS vll1 = []" using map lvl lvl1 unfolding vl vl1 v v1 by simp
                hence lvl1: "list_all isPVal vll1"
                using filter_list_all_isPVal_isOVal lvl1 unfolding vl1 v1 by auto
                hence "Δ11 s' vl' s1' vll1" using s's1' op1' op' PID' lvl lvl1 map cor1 pPID1 pPID1'
                unfolding Δ11_def vl vl' vl1 v v1 vll by auto
                thus ?thesis by auto
              next
                case False note vll = False
                hence "Δ1 s' vl' s1' vll1" using s's1' op1' op' PID' lvl lvl1 map cor1 pPID1 pPID1'
                unfolding Δ1_def vl vl' vl1 v v1 by auto
                thus ?thesis by auto
              qed
            qed
          thus ?thesis using vl by simp
        qed(insert lvl vl, auto)
      next
        case False note φ = False
        hence vl': "vl' = vl" using c unfolding consume_def by auto
        obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
        have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
        let ?trn1 = "Trans s1 a ou1 s1'"
        have φ1: "¬ φ ?trn1" using φ ss1 by (simp add: eqButPID_step_φ step step1)
        have pPID1': "post s1' PID = pst1"
          using PID1 pPID1 step1 φ1 (* unfolding φ_def2[OF step1] *)
          apply(cases a)
          subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
          subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
          subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
          subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
          subgoal by auto
          subgoal by auto
          subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
          done
        have op': "¬ open s'"
          using PID step φ op
          unfolding φ_def2[OF step1]
          apply(cases a)
          subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
          subgoal by auto
          subgoal by auto
          subgoal for x4 using φ_def2 φ step by blast
          subgoal by auto
          subgoal by auto
          subgoal using φ_def2 φ step by blast
          done
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def by simp
        next
          show "γ ?trn = γ ?trn1" unfolding ss1 by simp
        next
          assume "γ ?trn" note γ = this
          have ou: "(∃ uid p aid pid.
                   a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                   ou = ou1"
          using eqButPID_step_γ_out[OF ss1 step step1 op rsT rs1 γ] .
          thus "g ?trn = g ?trn1" by (cases a) auto
        next
          have "Δ1 s' vl' s1' vl1" using s's1' PID' pPID1 pPID1' lvl lvl1 map cor1 op'
          unfolding Δ1_def vl vl' by auto
          thus "?Δ s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vlvl1 by simp
  qed(insert lvl1 vl1, auto)
next
  case Nil note vl1 = Nil
  have ?react proof
    fix a :: act and ou :: out and s' :: state and vl'
    let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID ∈∈ postIDs s'" using reach_postIDs_persist[OF PID step] .
      obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
      let ?trn1 = "Trans s1 a ou1 s1'"
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof(cases "∃ uid p pstt. a = Uact (uPost uid p PID pstt) ∧ ou = outOK")
        case True then obtain uid p pstt where
        a: "a = Uact (uPost uid p PID pstt)" and ou: "ou = outOK" by auto
        hence φ: "φ ?trn" unfolding φ_def2[OF step] by auto
        then obtain v where vl: "vl = v # vl'" and f: "f ?trn = v"
        using c unfolding consume_def φ_def2 by (cases vl) auto
        obtain pst where v: "v = PVal pst" using map lvl unfolding vl vl1 by (cases v) auto
        have pstt: "pstt = pst" using f unfolding a v by auto
        have uid: "uid ∉ UIDs" using step op PID unfolding a ou open_def by (auto simp: u_defs)
        have "eqButPID s s'" using Uact_uPaperC_step_eqButPID[OF a step] by auto
        hence s's1: "eqButPID s' s1" using eqButPID_sym eqButPID_trans ss1 by blast
        have op': "¬ open s'" using step PID' op unfolding a ou open_def by (auto simp: u_defs)
        have ?ignore proof
          show "¬ γ ?trn" unfolding a using uid by auto
        next
          show "?Δ s' vl' s1 vl1" using PID' s's1 op' lvl map
          unfolding Δ1_def vl1 vl by auto
        qed
        thus ?thesis by simp
      next
        case False note a = False
        {assume φ: "φ ?trn"
         then obtain v vl' where vl: "vl = v # vl'" and f: "f ?trn = v"
         using c unfolding consume_def by (cases vl) auto
         obtain pst where v: "v = PVal pst" using map lvl unfolding vl vl1 by (cases v) auto
         have False using f f_eq_PVal[OF step φ, of pst] a φ v by auto
        }
        hence φ: "¬ φ ?trn" by auto
        have φ1: "¬ φ ?trn1" by (metis φ eqButPID_step_φ step ss1 step1)
        have op': "¬ open s'" using a op φ unfolding φ_def2[OF step] by auto
        have vl': "vl' = vl" using c φ unfolding consume_def by auto
        have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
        have op1': "¬ open s1'" using op' eqButPID_open[OF s's1'] by simp
        have "⋀ uid p pst. e_updatePost s1 uid p PID pst ⟷ e_updatePost s uid p PID pst"
        using eqButPID_stateSelectors[OF ss1] unfolding u_defs by auto
        hence ou1: "⋀ uid p pst. a = Uact (uPost uid p PID pst) ⟹ ou1 = ou"
        using step step1 by auto
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def by simp
        next
          show "γ ?trn = γ ?trn1" unfolding ss1 by simp
        next
          assume "γ ?trn" note γ = this
          have ou: "(∃ uid p aid pid.
                       a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                                        ou = ou1"
          using eqButPID_step_γ_out[OF ss1 step step1 op rsT rs1 γ] .
          thus "g ?trn = g ?trn1" by (cases a) auto
        next
          show "?Δ s' vl' s1' vl1" using s's1' op' PID' lvl map
          unfolding Δ1_def vl' vl1 by auto
        qed
      thus ?thesis by simp
      qed
    qed
    thus ?thesis using vlvl1 by simp
  qed
qed

lemma unwind_cont_Δ11: "unwind_cont Δ11 {Δ11}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ11 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ11 s vl s1 vl1"
  hence  vl: "vl = []" and lvl1: "list_all isPVal vl1"
  and rs: "reach s" and ss1: "eqButPID s s1" and op: "¬ open s" and PID: "PID ∈∈ postIDs s"
  and cor1: "corrFrom (post s1 PID) vl1"
  using reachNT_reach unfolding Δ11_def by auto
  have PID1: "PID ∈∈ postIDs s1" using eqButPID_stateSelectors[OF ss1] PID by auto
  have own: "owner s PID ∈ set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  hence own1: "owner s1 PID ∈ set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  have adm: "admin s ∈ set (userIDs s)" using reach_admin_userIDs[OF rs own] .
  hence adm1: "admin s1 ∈ set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  have op1: "¬ open s1" using op ss1 eqButPID_open by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof(cases vl1)
    case (Cons v1 vll1) note vl1 = Cons
    then obtain pst1 where v1: "v1 = PVal pst1" using lvl1 unfolding vl1 by (cases v1) auto
    define uid where uid: "uid ≡ owner s PID"  define p where p: "p ≡ pass s uid"
    define a1 where a1: "a1 ≡ Uact (uPost uid p PID pst1)"
    have uid1: "uid = owner s1 PID" and p1: "p = pass s1 uid" unfolding uid p
    using eqButPID_stateSelectors[OF ss1] by auto
    obtain ou1 s1' where step1: "step s1 a1 = (ou1, s1')" by(cases "step s1 a1") auto
    have ou1: "ou1 = outOK" using step1 PID1 own1 unfolding a1 uid1 p1 by (auto simp: u_defs)
    have op1': "¬ open s1'" using step1 op1 unfolding a1 ou1 open_def by (auto simp: u_defs)
    have uid: "uid ∉ UIDs" unfolding uid using op PID own unfolding open_def by auto
    have pPID1': "post s1' PID = pst1" using step1 unfolding a1 ou1 by (auto simp: u_defs)
    let ?trn1 = "Trans s1 a1 ou1 s1'"
    have ?iact proof
      show "step s1 a1 = (ou1, s1')" using step1 .
    next
      show φ: "φ ?trn1" unfolding φ_def2[OF step1] a1 ou1 by simp
      show "consume ?trn1 vl1 vll1"
      using φ unfolding vl1 consume_def v1 a1 by auto
    next
      show "¬ γ ?trn1" using uid unfolding a1 by auto
    next
      have "eqButPID s1 s1'" using Uact_uPaperC_step_eqButPID[OF _ step1] a1 by auto
      hence ss1': "eqButPID s s1'" using eqButPID_trans ss1 by blast
      show "?Δ s vl s1' vll1"
      using PID op ss1' lvl1 cor1 unfolding Δ11_def vl1 v1 vl pPID1' by auto
    qed
    thus ?thesis by simp
  next
    case Nil note vl1 = Nil
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and c: "consume ?trn vl vl'"
      have PID': "PID ∈∈ postIDs s'" using reach_postIDs_persist[OF PID step] .
      obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
      let ?trn1 = "Trans s1 a ou1 s1'"
      have φ: "¬ φ ?trn" using c unfolding consume_def vl by auto
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'"
          (is "?match ∨ ?ignore")
      proof-
        have vl': "vl' = vl" using c unfolding vl consume_def by auto
        obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
        have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
        let ?trn1 = "Trans s1 a ou1 s1'"
        have φ1: "¬ φ ?trn1" using φ ss1 by (simp add: eqButPID_step_φ step step1)
        have pPID1': "post s1' PID = post s1 PID" using PID1 step1 φ1
        apply(cases a)
          subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
          subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
          subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
          subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
          subgoal by auto
          subgoal by auto
          subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
        done
        have op': "¬ open s'"
          using PID step φ op unfolding φ_def2[OF step]
          by auto
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def by simp
        next
          show "γ ?trn = γ ?trn1" unfolding ss1 by simp
        next
          assume "γ ?trn" note γ = this
          have ou: "(∃ uid p aid pid.
                   a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                   ou = ou1"
          using eqButPID_step_γ_out[OF ss1 step step1 op rsT rs1 γ] .
          thus "g ?trn = g ?trn1" by (cases a) auto
        next
          have "?Δ s' vl' s1' vl1" using s's1' PID' pPID1' lvl1 cor1 op'
          unfolding Δ11_def vl vl' by auto
          thus "?Δ s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl1 by simp
  qed
qed

lemma unwind_cont_Δ31: "unwind_cont Δ31 {Δ31,Δ32}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ31 s vl s1 vl1 ∨ Δ32 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ31 s vl s1 vl1"
  then obtain ul ul1 sul vll vll1 where
  lul: "list_all (Not ∘ isOVal) ul" and lul1: "list_all (Not ∘ isOVal) ul1"
  and map: "map tgtAPI (filter isPValS ul) = map tgtAPI (filter isPValS ul1)"
  and rs: "reach s" and ss1: "eqButPID s s1" and op: "¬ open s" and PID: "PID ∈∈ postIDs s"
  and cor1: "corrFrom (post s1 PID) vl1"
  and ful: "ul ≠ []" and ful1: "ul1 ≠ []"
  and lastul: "isPVal (last ul)" and ulul1: "last ul = last ul1"
  and lsul: "list_all isPValS sul"
  and vl: "vl = ul @ sul @ OVal True # vll"
  and vl1: "vl1 = ul1 @ sul @ OVal True # vll1"
  and BO: "BO vll vll1"
  using reachNT_reach unfolding Δ31_def by auto
  have ulNE: "ul ≠ []" and ul1NE: "ul1 ≠ []" using ful ful1 by auto
  have PID1: "PID ∈∈ postIDs s1" using eqButPID_stateSelectors[OF ss1] PID by auto
  have own: "owner s PID ∈ set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  hence own1: "owner s1 PID ∈ set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  have adm: "admin s ∈ set (userIDs s)" using reach_admin_userIDs[OF rs own] .
  hence adm1: "admin s1 ∈ set (userIDs s1)" using eqButPID_stateSelectors[OF ss1] by auto
  have op1: "¬ open s1" using op ss1 eqButPID_open by auto
  obtain v1 ull1 where ul1: "ul1 = v1 # ull1" using ful1 by (cases ul1) auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof(cases v1)
    case (PVal pst1) note v1 = PVal
    show ?thesis proof(cases "list_ex isPVal ull1")
      case True note lull1 = True
      hence full1: "filter isPVal ull1 ≠ []" by (induct ull1) auto
      hence ull1NE: "ull1 ≠ []" by auto
      define uid where uid: "uid ≡ owner s PID"  define p where p: "p ≡ pass s uid"
      define a1 where a1: "a1 ≡ Uact (uPost uid p PID pst1)"
      have uid1: "uid = owner s1 PID" and p1: "p = pass s1 uid" unfolding uid p
      using eqButPID_stateSelectors[OF ss1] by auto
      obtain ou1 s1' where step1: "step s1 a1 = (ou1, s1')" by(cases "step s1 a1") auto
      have ou1: "ou1 = outOK" using step1 PID1 own1 unfolding a1 uid1 p1 by (auto simp: u_defs)
      have op1': "¬ open s1'" using step1 op1 unfolding a1 ou1 open_def by (auto simp: u_defs)
      have uid: "uid ∉ UIDs" unfolding uid using op PID own unfolding open_def by auto
      have pPID1': "post s1' PID = pst1" using step1 unfolding a1 ou1 by (auto simp: u_defs)
      let ?trn1 = "Trans s1 a1 ou1 s1'"
      let ?vl1' = "ull1 @ sul @ OVal True # vll1"
      have ?iact proof
        show "step s1 a1 = (ou1, s1')" using step1 .
      next
        show φ: "φ ?trn1" unfolding φ_def2[OF step1] a1 ou1 by simp
        show "consume ?trn1 vl1 ?vl1'"
        using φ unfolding vl1 ul1 consume_def v1 a1 by simp
      next
        show "¬ γ ?trn1" using uid unfolding a1 by auto
      next
        have "eqButPID s1 s1'" using Uact_uPaperC_step_eqButPID[OF _ step1] a1 by auto
        hence ss1': "eqButPID s s1'" using eqButPID_trans ss1 by blast
        have "Δ31 s vl s1' ?vl1'"
        using PID op ss1' lul lul1 map ulul1 cor1 BO ull1NE ful ful1 full1 lastul ulul1 lsul
        unfolding Δ31_def vl vl1 ul1 v1 pPID1' apply auto
        apply(rule exI[of _ "ul"]) apply(rule exI[of _ "ull1"]) apply(rule exI[of _ sul])
        apply(rule exI[of _ "vll"]) apply(rule exI[of _ "vll1"]) by auto
        thus "?Δ s vl s1' ?vl1'" by auto
      qed
      thus ?thesis by simp
    next
      case False note lull1 = False
      hence ull1: "ull1 = []" using lastul unfolding ulul1 ul1 v1 by simp(meson Bex_set last_in_set)
      hence ul1: "ul1 = [PVal pst1]" unfolding ul1 v1 by simp
      obtain ulll where ul_ulll: "ul = ulll ## PVal pst1" using lastul ulul1 ulNE unfolding ul1 ull1 v1
      by (cases ul rule: rev_cases) auto
      hence ulNE: "ul ≠ []" by simp
      (* then obtain v ul' where ul: "ul = v # ul'" by (cases ul) auto *)
      have "filter isPValS ulll = []" using map unfolding ul_ulll ul1 v1 ull1 by simp
      hence lull: "list_all isPVal ulll" using lul filter_list_all_isPVal_isOVal
      unfolding ul_ulll by auto
      have ?react  proof
        fix a :: act and ou :: out and s' :: state and vl'
        let ?trn = "Trans s a ou s'"
        assume step: "step s a = (ou, s')" and c: "consume ?trn vl vl'"
        have PID': "PID ∈∈ postIDs s'" using reach_postIDs_persist[OF PID step] .
        obtain ul' where cc: "consume ?trn ul ul'" and
        vl': "vl' = ul' @ sul @ OVal True # vll" using c ulNE unfolding consume_def vl
        by (cases "φ ?trn") auto
        obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
        let ?trn1 = "Trans s1 a ou1 s1'"
        show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'"
             (is "?match ∨ ?ignore")
        proof(cases ulll)
          case Nil
          hence ul: "ul = [PVal pst1]" unfolding ul_ulll by simp
          have ?match proof(cases "φ ?trn")
            case True note φ = True
            then obtain f: "f ?trn = PVal pst1" and ul': "ul' = []"
            using cc unfolding ul consume_def φ_def2 by auto
            define uid where uid: "uid ≡ owner s PID"  define p where p: "p ≡ pass s uid"
            have a: "a = Uact (uPost uid p PID pst1)"
            using f_eq_PVal[OF step φ f] unfolding uid p .
            have uid1: "uid = owner s1 PID" and p1: "p = pass s1 uid" unfolding uid p
            using eqButPID_stateSelectors[OF ss1] by auto
            obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
            let ?trn1 = "Trans s1 a ou1 s1'"
            have φ1: "φ ?trn1" using eqButPID_step_φ_imp[OF ss1 step step1 φ] .
            have ou1: "ou1 = outOK"
            using φ1 step1 PID1 unfolding a by (cases ou1, auto simp: com_defs)
            have pPID': "post s' PID = pst1" using step φ unfolding a by (auto simp: u_defs)
            have pPID1': "post s1' PID = pst1" using step1 φ1 unfolding a by (auto simp: u_defs)
            have uid: "uid ∉ UIDs" unfolding uid using op PID own unfolding open_def by auto
            have op1': "¬ open s1'" using step1 op1 unfolding a open_def
            by (auto simp: u_defs com_defs)
            have f1: "f ?trn1 = PVal pst1" using φ1 unfolding φ_def2[OF step1] v1 a ou1 by auto
            have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
            have op': "¬ open s'" using uPost_comSendPost_open_eq[OF step] a op by auto
            have ou: "ou = outOK" using φ op op' unfolding φ_def2[OF step] a by auto
            let ?vl' = "sul @ OVal True # vll"
            let ?vl1' = "sul @ OVal True # vll1"
            show ?thesis proof
              show "validTrans ?trn1" using step1 by simp
            next
              show "consume ?trn1 vl1 ?vl1'"
              using φ1 unfolding consume_def ul1 f1 vl1 by simp
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" note γ = this
              thus "g ?trn = g ?trn1" using ou ou1 by (cases a) auto
            next
              have s': "s' = s1'" using eqButPID_step_eq[OF ss1 a ou step step1] .
              have corr1: "corrFrom (post s1' PID) ?vl1'"
              using cor1 unfolding vl1 ul1 v1 pPID1' by auto
              have "Δ32 s' vl' s1' ?vl1'"
              using PID' op1 op' s's1' lul lul1 map ulul1 cor1 BO ful ful1 lastul ulul1 lsul corr1
              unfolding Δ32_def vl vl1 v1 vl' ul' ul ul1 s' apply simp
              apply(rule exI[of _ sul])
              apply(rule exI[of _ "vll"]) apply(rule exI[of _ "vll1"]) by auto
              thus "?Δ s' vl' s1' ?vl1'" by simp
            qed
          next
            case False note φ = False
            hence ul': "ul' = ul" using cc unfolding consume_def by auto
            obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
            have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
            let ?trn1 = "Trans s1 a ou1 s1'"
            have φ1: "¬ φ ?trn1" using φ ss1 by (simp add: eqButPID_step_φ step step1)
            have pPID1': "post s1' PID = post s1 PID" using PID1 step1 φ1
            apply(cases a)
              subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
              subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
              subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
              subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
              subgoal by auto
              subgoal by auto
              subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
            done
            have op': "¬ open s'"
            using PID step φ op unfolding φ_def2[OF step] by auto
            have ?match proof
              show "validTrans ?trn1" using step1 by simp
            next
              show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def by simp
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" note γ = this
              have ou: "(∃ uid p aid pid.
                 a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                 ou = ou1"
              using eqButPID_step_γ_out[OF ss1 step step1 op rsT rs1 γ] .
              thus "g ?trn = g ?trn1" by (cases a) auto
            next
              have "Δ31 s' vl' s1' vl1"
              using PID' pPID1' op' s's1' lul lul1 map ulul1 cor1
              BO ful ful1 lastul ulul1 lsul cor1
              unfolding Δ31_def vl vl1 v1 vl' ul' apply simp
              apply(rule exI[of _ "ul"]) apply(rule exI[of _ "ul1"]) apply(rule exI[of _ sul])
              apply(rule exI[of _ "vll"]) apply(rule exI[of _ "vll1"]) by auto
              thus "?Δ s' vl' s1' vl1" by simp
            qed
            thus ?thesis by simp
          qed
          thus ?thesis by simp
        next
          case (Cons v ullll) note ulll = Cons
          then obtain pst where v: "v = PVal pst" using lull ul_ulll ulll lul by (cases v) auto
          define ull where ull: "ull ≡ ullll ## PVal pst1"
          have ul: "ul = v # ull" unfolding ul_ulll ull ulll by simp
          show ?thesis proof(cases "φ ?trn")
            case True note φ = True
            then obtain f: "f ?trn = v" and ul': "ul' = ull"
            using cc unfolding ul consume_def φ_def2 by auto
            define uid where uid: "uid ≡ owner s PID"  define p where p: "p ≡ pass s uid"
            have a: "a = Uact (uPost uid p PID pst)"
            using f_eq_PVal[OF step φ f[unfolded v]] unfolding uid p .
            have "eqButPID s s'" using Uact_uPaperC_step_eqButPID[OF a step] by auto
            hence s's1: "eqButPID s' s1" using eqButPID_sym eqButPID_trans ss1 by blast
            have op': "¬ open s'" using uPost_comSendPost_open_eq[OF step] a op by auto
            have ?ignore proof
              show γ: "¬ γ ?trn" using step_open_φ_f_PVal_γ[OF rs step PID op φ f[unfolded v]] .
              have "Δ31 s' vl' s1 vl1"
              using PID' op' s's1 lul lul1 map ulul1 cor1 BO ful ful1 lastul ulul1 lsul ull
              unfolding Δ31_def vl vl1 v1 vl' ul' ul v apply simp
              apply(rule exI[of _ "ull"]) apply(rule exI[of _ "ul1"]) apply(rule exI[of _ sul])
              apply(rule exI[of _ "vll"]) apply(rule exI[of _ "vll1"]) by auto
              thus "?Δ s' vl' s1 vl1" by auto
            qed
            thus ?thesis by simp
          next
            case False note φ = False
            hence ul': "ul' = ul" using cc unfolding consume_def by auto
            obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
            have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
            let ?trn1 = "Trans s1 a ou1 s1'"
            have φ1: "¬ φ ?trn1" using φ ss1 by (simp add: eqButPID_step_φ step step1)
            have pPID1': "post s1' PID = post s1 PID" using PID1 step1 φ1
            apply(cases a)
              subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
              subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
              subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
              subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
              subgoal by auto
              subgoal by auto
              subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
            done
            have op': "¬ open s'"
            using PID step φ op unfolding φ_def2[OF step] by auto
            have ?match proof
              show "validTrans ?trn1" using step1 by simp
            next
              show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def by simp
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" note γ = this
              have ou: "(∃ uid p aid pid.
                 a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                 ou = ou1"
              using eqButPID_step_γ_out[OF ss1 step step1 op rsT rs1 γ] .
              thus "g ?trn = g ?trn1" by (cases a) auto
            next
              have "Δ31 s' vl' s1' vl1"
              using PID' pPID1' op' s's1' lul lul1 map ulul1 cor1
              BO ful ful1 lastul ulul1 lsul cor1
              unfolding Δ31_def vl vl1 v1 vl' ul' apply simp
              apply(rule exI[of _ "ul"]) apply(rule exI[of _ "ul1"]) apply(rule exI[of _ sul])
              apply(rule exI[of _ "vll"]) apply(rule exI[of _ "vll1"]) by auto
              thus "?Δ s' vl' s1' vl1" by simp
            qed
          thus ?thesis by simp
          qed
        qed
      qed
      thus ?thesis using vl by simp
    qed
  next
    case (PValS aid1 pst1) note v1 = PValS
    have pPID1: "post s1 PID = pst1" using cor1 unfolding vl1 ul1 v1 by auto
    then obtain v ull where ul: "ul = v # ull"
    using map unfolding ul1 v1 by (cases ul) auto
    let ?vl1' = "ull1 @ sul @ OVal True # vll1"
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and c: "consume ?trn vl vl'"
      have PID': "PID ∈∈ postIDs s'" using reach_postIDs_persist[OF PID step] .
      obtain ul' where cc: "consume ?trn ul ul'" and
      vl': "vl' = ul' @ sul @ OVal True # vll" using c ul unfolding consume_def vl
      by (cases "φ ?trn") auto
      obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
      let ?trn1 = "Trans s1 a ou1 s1'"
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'"
          (is "?match ∨ ?ignore")
      proof(cases "φ ?trn")
        case True note φ = True
        then obtain f: "f ?trn = v" and ul': "ul' = ull"
        using cc unfolding ul consume_def φ_def2 by auto
        show ?thesis
        proof(cases v)
          case (PVal pst) note v = PVal
          have full: "ull ≠ []" using map unfolding ul1 v1 ul v by auto
          define uid where uid: "uid ≡ owner s PID"  define p where p: "p ≡ pass s uid"
          have a: "a = Uact (uPost uid p PID pst)"
          using f_eq_PVal[OF step φ f[unfolded v]] unfolding uid p .
          have "eqButPID s s'" using Uact_uPaperC_step_eqButPID[OF a step] by auto
          hence s's1: "eqButPID s' s1" using eqButPID_sym eqButPID_trans ss1 by blast
          have op': "¬ open s'" using uPost_comSendPost_open_eq[OF step] a op by auto
          (* have "list_ex isPVal ull1" using lastul not_list_ex_filter
          using ful1 not_list_ex_filter ul1 v1 unfolding ulul1 by auto
          hence lull: "list_ex isPVal ull" using lastul ulul1 ull unfolding ul ul1 v v1
          by (metis filter_empty_conv last_ConsR last_in_set not_list_ex_filter)
          hence full: "filter isPVal ull ≠ []" by (induct ull) auto *)
          have ?ignore proof
            show γ: "¬ γ ?trn" using step_open_φ_f_PVal_γ[OF rs step PID op φ f[unfolded v]] .
            have "Δ31 s' vl' s1 vl1"
            using PID' op' s's1 lul lul1 map ulul1 cor1 BO ful ful1 lastul ulul1 lsul full
            unfolding Δ31_def vl vl1 v1 vl' ul' ul v apply simp
            apply(rule exI[of _ "ull"]) apply(rule exI[of _ "ul1"]) apply(rule exI[of _ sul])
            apply(rule exI[of _ "vll"]) apply(rule exI[of _ "vll1"]) by auto
            thus "?Δ s' vl' s1 vl1" by auto
          qed
          thus ?thesis by simp
        next
          case (PValS aid pst) note v = PValS
          define uid where uid: "uid ≡ admin s" define p where p: "p ≡ pass s uid"
          have a: "a = COMact (comSendPost (admin s) p aid PID)"
          using f_eq_PValS[OF step φ f[unfolded v]] unfolding uid p .
          have op': "¬ open s'" using uPost_comSendPost_open_eq[OF step] a op by auto
          have aid1: "aid1 = aid" using map unfolding ul1 v1 ul v by simp
          have uid1: "uid = admin s1" and p1: "p = pass s1 uid" unfolding uid p
          using eqButPID_stateSelectors[OF ss1] by auto
          obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
          have pPID1': "post s1' PID = pst1" using pPID1 step1 unfolding a
          by (auto simp: com_defs)
          have uid: "uid ∉ UIDs" unfolding uid using op PID adm unfolding open_def by auto
          have op1': "¬ open s1'" using step1 op1 unfolding a open_def
          by (auto simp: u_defs com_defs)
          let ?trn1 = "Trans s1 a ou1 s1'"
          have φ1: "φ ?trn1" using eqButPID_step_φ_imp[OF ss1 step step1 φ] .
          have ou1: "ou1 =
            O_sendPost (aid, clientPass s1 aid, PID, post s1 PID, owner s1 PID, vis s1 PID)"
          using φ1 step1 adm1 PID1 unfolding a by (cases ou1, auto simp: com_defs)
          have f1: "f ?trn1 = v1" using φ1 unfolding φ_def2[OF step1] v1 a ou1 aid1 pPID1 by auto
          have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
          have ?match proof
            show "validTrans ?trn1" using step1 by simp
          next
            show "consume ?trn1 vl1 ?vl1'" using φ1 unfolding consume_def ul1 f1 vl1 by simp
          next
            show "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" note γ = this
            have ou: "(∃ uid p aid pid.
               a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
               ou = ou1"
            using eqButPID_step_γ_out[OF ss1 step step1 op rsT rs1 γ] .
            thus "g ?trn = g ?trn1" by (cases a) auto
          next
            have corr1: "corrFrom (post s1' PID) ?vl1'"
            using cor1 unfolding vl1 ul1 v1 pPID1' by auto
            have ullull1: "ull1 ≠ [] ⟶ ull ≠ []" using ul ul1 lastul ulul1 unfolding v v1
            by fastforce
            have "Δ31 s' vl' s1' ?vl1'"
            using PID' op' s's1' lul lul1 map ulul1 cor1 BO ful ful1 lastul ulul1 lsul corr1 ullull1
            unfolding Δ31_def vl vl1 v1 vl' ul' ul ul1 v apply auto
            apply(rule exI[of _ "ull"]) apply(rule exI[of _ "ull1"]) apply(rule exI[of _ sul])
            apply(rule exI[of _ "vll"]) apply(rule exI[of _ "vll1"]) by auto
            thus "?Δ s' vl' s1' ?vl1'" by simp
          qed
          thus ?thesis using ul by simp
        next
        qed(insert lul ul, auto)
      next
        case False note φ = False
        hence ul': "ul' = ul" using cc unfolding consume_def by auto
        obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by(cases "step s1 a") auto
        have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 step step1] .
        let ?trn1 = "Trans s1 a ou1 s1'"
        have φ1: "¬ φ ?trn1" using φ ss1 by (simp add: eqButPID_step_φ step step1)
        have pPID1': "post s1' PID = pst1" using PID1 pPID1 step1 φ1
        apply(cases a)
          subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
          subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
          subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
          subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
          subgoal by auto
          subgoal by auto
          subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
        done
        have op': "¬ open s'"
        using PID step φ op unfolding φ_def2[OF step] by auto
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def by simp
        next
          show "γ ?trn = γ ?trn1" unfolding ss1 by simp
        next
          assume "γ ?trn" note γ = this
          have ou: "(∃ uid p aid pid.
                 a = COMact (comSendPost uid p aid pid) ∧ outPurge ou = outPurge ou1) ∨
                 ou = ou1"
          using eqButPID_step_γ_out[OF ss1 step step1 op rsT rs1 γ] .
          thus "g ?trn = g ?trn1" by (cases a) auto
        next
          have "Δ31 s' vl' s1' vl1"
          using PID' pPID1 pPID1' op' s's1' lul lul1 map ulul1 cor1
            BO ful ful1 lastul ulul1 lsul cor1
          unfolding Δ31_def vl vl1 v1 vl' ul' apply simp
          apply(rule exI[of _ "ul"]) apply(rule exI[of _ "ul1"]) apply(rule exI[of _ sul])
          apply(rule exI[of _ "vll"]) apply(rule exI[of _ "vll1"]) by auto
          thus "?Δ s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl by simp
  qed(insert lul1 ul1, auto)
qed

lemma unwind_cont_Δ32: "unwind_cont Δ32 {Δ2,Δ32,Δ4}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ2 s vl s1 vl1 ∨ Δ32 s vl s1 vl1 ∨ Δ4 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ32 s vl s1 vl1"
  then obtain ul vll vll1 where
  lul: "list_all isPValS ul"
  and rs: "reach s" and ss1: "s1 = s" and op: "¬ open s" and PID: "PID ∈∈ postIDs s"
  and cor1: "corrFrom (post s1 PID) vl1"
  and vl: "vl = ul @ OVal True # vll"
  and vl1: "vl1 = ul @ OVal True # vll1"
  and BO: "BO vll vll1"
  using reachNT_reach unfolding Δ32_def by blast
  have own: "owner s PID ∈ set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  have adm: "admin s ∈ set (userIDs s)" using reach_admin_userIDs[OF rs own] .
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'" let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and c: "consume ?trn vl vl'"
      have PID': "PID ∈∈ postIDs s'" using reach_postIDs_persist[OF PID step] .
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'"
          (is "?match ∨ ?ignore")
      proof-
        have ?match proof(cases "ul = []")
          case False note ul = False
          then obtain ul' where cc: "consume ?trn ul ul'"
          and vl': "vl' = ul' @ OVal True # vll" using vl c unfolding consume_def
          by (cases "φ ?trn") auto
          let ?vl1' = "ul' @ OVal True # vll1"
          show ?thesis proof
            show "validTrans ?trn1" using step unfolding ss1 by simp
          next
            show "consume ?trn1 vl1 ?vl1'" using cc ul unfolding vl1 consume_def ss1
            by (cases "φ ?trn") auto
          next
            show "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" note γ = this
            thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            have "Δ32 s' vl' s' ?vl1'"
            proof(cases "φ ?trn")
              case True note φ = True
              then obtain v where f: "f ?trn = v" and  ul: "ul = v # ul'"
              using cc unfolding consume_def by (cases ul) auto
              define uid where uid: "uid ≡ admin s" define p where p: "p ≡ pass s uid"
              obtain aid pst where v: "v = PValS aid pst" using lul unfolding ul by (cases v) auto
              have a: "a = COMact (comSendPost (admin s) p aid PID)"
              using f_eq_PValS[OF step φ f[unfolded v]] unfolding uid p .
              have op': "¬ open s'" using uPost_comSendPost_open_eq[OF step] a op by auto
              have pPID': "post s' PID = post s PID"
              using step unfolding a by (auto simp: com_defs)
              show ?thesis using PID' pPID' op' cor1 BO lul
              unfolding Δ32_def vl1 ul ss1 v vl' by auto
            next
              case False note φ = False
              hence ul: "ul = ul'" using cc unfolding consume_def by (cases ul) auto
              have pPID': "post s' PID = post s PID"
              using step φ PID op
              apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
                subgoal for x4 apply(cases x4) apply(auto simp: u_defs) .
                subgoal by auto
                subgoal by auto
                subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
              done
              have op': "¬ open s'"
              using PID step φ op unfolding φ_def2[OF step] by auto
              show ?thesis using PID' pPID' op' cor1 BO lul
              unfolding Δ32_def vl1 ul ss1 vl' by auto
            qed
            thus "?Δ s' vl' s' ?vl1'" by simp
          qed
        next
          case True note ul = True
          show ?thesis proof(cases "φ ?trn")
            case True note φ = True
            hence f: "f ?trn = OVal True" and vl': "vl' = vll"
            using vl c unfolding consume_def ul by auto
            have op': "open s'" using f_eq_OVal[OF step φ f] op by simp
            show ?thesis proof
              show "validTrans ?trn1" using step unfolding ss1 by simp
            next
              show "consume ?trn1 vl1 vll1" using ul φ c
              unfolding vl1 vl' vl ss1 consume_def by auto
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" note γ = this
              thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              have pPID': "post s' PID = post s PID"
              using step φ PID op op' f
              apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
                subgoal for x4 apply(cases x4) apply(auto simp: u_defs) .
                subgoal by auto
                subgoal by auto
                subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
              done
              show "?Δ s' vl' s' vll1" using BO proof cases
                case BO_PVal
                hence "Δ2 s' vl' s' vll1" using PID' pPID' op' cor1 BO lul
                unfolding Δ2_def vl1 ul ss1 vl' by auto
                thus ?thesis by simp
              next
                case BO_BC
                hence "Δ4 s' vl' s' vll1" using PID' pPID' op' cor1 BO lul
                unfolding Δ4_def vl1 ul ss1 vl' by auto
                thus ?thesis by simp
              qed
            qed
          next
            case False note φ = False
            hence vl': "vl' = vl" using c unfolding consume_def by auto
            have pPID': "post s' PID = post s PID"
            using step φ PID op
            apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
                subgoal for x4 apply(cases x4) apply(auto simp: u_defs) .
                subgoal by auto
                subgoal by auto
                subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
            done
            have op': "¬ open s'"
            using PID step φ op unfolding φ_def2[OF step] by (cases a) auto
            show ?thesis proof
              show "validTrans ?trn1" using step unfolding ss1 by simp
            next
              show "consume ?trn1 vl1 vl1" using ul φ unfolding vl1 consume_def ss1 by simp
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" note γ = this
              thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              have "Δ32 s' vl' s' vl1" using PID' pPID' op' cor1 BO lul
              unfolding Δ32_def vl vl1 ul ss1 vl' apply simp
              apply(rule exI[of _ "[]"])
              apply(rule exI[of _ vll]) apply(rule exI[of _ vll1]) by auto
              thus "?Δ s' vl' s' vl1" by simp
            qed
          qed
        qed
        thus ?thesis by simp
      qed
    qed
  thus ?thesis using vl by simp
  qed
qed

lemma unwind_cont_Δ2: "unwind_cont Δ2 {Δ2}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ2 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ2 s vl s1 vl1"
  hence vlvl1: "vl = vl1"
  and rs: "reach s" and ss1: "s1 = s" and op: "open s" and PID: "PID ∈∈ postIDs s"
  and cor1: "corrFrom (post s1 PID) vl1" and lvl: "list_all (Not ∘ isOVal) vl"
  using reachNT_reach unfolding Δ2_def by auto
  have own: "owner s PID ∈ set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  have adm: "admin s ∈ set (userIDs s)" using reach_admin_userIDs[OF rs own] .
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and c: "consume ?trn vl vl'"
      have PID': "PID ∈∈ postIDs s'" using reach_postIDs_persist[OF PID step] .
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof-
        have ?match proof(cases "φ ?trn")
          case True note φ = True
          then obtain v where vl: "vl = v # vl'" and f: "f ?trn = v"
          using c unfolding consume_def φ_def2 by(cases vl) auto
          show ?thesis proof(cases v)
            case (PVal pst) note v = PVal
            have a: "a = Uact (uPost (owner s PID) (pass s (owner s PID)) PID pst)"
            using f_eq_PVal[OF step φ f[unfolded v]] .
            have ou: "ou = outOK" using step own PID unfolding a by (auto simp: u_defs)
            have op': "open s'" using step op PID PID' φ
            unfolding open_def a by (auto simp: u_defs)
            have pPID': "post s' PID = pst"
            using step φ PID op f op' unfolding a by(auto simp: u_defs)
            show ?thesis proof
              show "validTrans ?trn1" unfolding ss1 using step by simp
            next
              show "consume ?trn1 vl1 vl'" using φ vlvl1 unfolding ss1 consume_def vl f by auto
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              show "?Δ s' vl' s' vl'" using cor1 PID' pPID' op' lvl vlvl1 ss1
              unfolding Δ2_def vl v by auto
            qed
          next
            case (PValS aid pid) note v = PValS
            have a: "a = COMact (comSendPost (admin s) (pass s (admin s)) aid PID)"
            using f_eq_PValS[OF step φ f[unfolded v]] .
            have op': "open s'" using step op PID PID' φ
            unfolding open_def a by (auto simp: com_defs)
            have ou: "ou ≠ outErr" using φ op op' unfolding φ_def2[OF step] unfolding a by auto
            have pPID': "post s' PID = post s PID"
            using step φ PID op f op' unfolding a by(auto simp: com_defs)
            show ?thesis proof
              show "validTrans ?trn1" unfolding ss1 using step by simp
            next
              show "consume ?trn1 vl1 vl'" using φ vlvl1 unfolding ss1 consume_def vl f by auto
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              show "?Δ s' vl' s' vl'" using cor1 PID' pPID' op' lvl vlvl1 ss1
              unfolding Δ2_def vl v by auto
            qed
          qed(insert vl lvl, auto)
        next
          case False note φ = False
          hence vl': "vl' = vl" using c unfolding consume_def by auto
          have pPID': "post s' PID = post s PID"
            using step φ PID op
            apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
                subgoal for x4 apply(cases x4) apply(auto simp: u_defs) .
                subgoal by auto
                subgoal by auto
                subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
            done
          have op': "open s'"
            using PID step φ op unfolding φ_def2[OF step] by (cases a) auto
          show ?thesis proof
            show "validTrans ?trn1" unfolding ss1 using step by simp
          next
            show "consume ?trn1 vl1 vl" using φ vlvl1 unfolding ss1 consume_def vl' by simp
          next
            show "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            show "?Δ s' vl' s' vl" using cor1 PID' op' lvl vlvl1 pPID'
            unfolding Δ2_def vl' ss1 by auto
          qed
        qed
      thus ?thesis by simp
      qed
    qed
  thus ?thesis using vlvl1 by simp
  qed
qed

lemma unwind_cont_Δ4: "unwind_cont Δ4 {Δ1,Δ31,Δ32,Δ4}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ1 s vl s1 vl1 ∨ Δ31 s vl s1 vl1 ∨ Δ32 s vl s1 vl1 ∨ Δ4 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ4 s vl s1 vl1"
  then obtain ul vll vll1 where vl: "vl = ul @ OVal False # vll" and vl1: "vl1 = ul @ OVal False # vll1"
  and rs: "reach s" and ss1: "s1 = s" and op: "open s" and PID: "PID ∈∈ postIDs s"
  and cor1: "corrFrom (post s1 PID) vl1" and lul: "list_all (Not ∘ isOVal) ul"
  and BC: "BC vll vll1"
  using reachNT_reach unfolding Δ4_def by blast
  have own: "owner s PID ∈ set (userIDs s)" using reach_owner_userIDs[OF rs PID] .
  have adm: "admin s ∈ set (userIDs s)" using reach_admin_userIDs[OF rs own] .
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and c: "consume ?trn vl vl'"
      have PID': "PID ∈∈ postIDs s'" using reach_postIDs_persist[OF PID step] .
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof-
        have ?match proof(cases "φ ?trn")
          case True note φ = True
          then obtain v where vl_vl': "vl = v # vl'" and f: "f ?trn = v"
          using c unfolding consume_def φ_def2 by(cases vl) auto
          show ?thesis proof(cases "ul = []")
            case False note ul = False
            then obtain ul' where ul: "ul = v # ul'" and vl': "vl' = ul' @ OVal False # vll"
            using c φ f unfolding consume_def vl by (cases ul) auto
            let ?vl1' = "ul' @ OVal False # vll1"
            show ?thesis proof(cases v)
              case (PVal pst) note v = PVal
              have a: "a = Uact (uPost (owner s PID) (pass s (owner s PID)) PID pst)"
              using f_eq_PVal[OF step φ f[unfolded v]] .
              have ou: "ou = outOK" using step own PID unfolding a by (auto simp: u_defs)
              have op': "open s'" using step op PID PID' φ
              unfolding open_def a by (auto simp: u_defs)
              have pPID': "post s' PID = pst"
              using step φ PID op f op' unfolding a by(auto simp: u_defs)
              show ?thesis proof
                show "validTrans ?trn1" unfolding ss1 using step by simp
              next
                show "consume ?trn1 vl1 ?vl1'" using φ
                unfolding ss1 consume_def vl f ul vl1 vl' by simp
              next
                show "γ ?trn = γ ?trn1" unfolding ss1 by simp
              next
                assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
              next
                have "Δ4 s' vl' s' ?vl1'" using cor1 PID' pPID' op' vl1 ss1 lul BC
                unfolding Δ4_def vl v ul vl' apply simp
                apply(rule exI[of _ ul'])
                apply(rule exI[of _ vll]) apply(rule exI[of _ vll1])
                by auto
                thus "?Δ s' vl' s' ?vl1'" by simp
              qed
            next
              case (PValS aid pid) note v = PValS
              have a: "a = COMact (comSendPost (admin s) (pass s (admin s)) aid PID)"
              using f_eq_PValS[OF step φ f[unfolded v]] .
              have op': "open s'" using step op PID PID' φ
              unfolding open_def a by (auto simp: com_defs)
              have ou: "ou ≠ outErr" using φ op op' unfolding φ_def2[OF step] unfolding a by auto
              have pPID': "post s' PID = post s PID"
              using step φ PID op f op' unfolding a by(auto simp: com_defs)
              show ?thesis proof
                show "validTrans ?trn1" unfolding ss1 using step by simp
              next
                show "consume ?trn1 vl1 ?vl1'" using φ
                unfolding ss1 consume_def vl f ul vl1 vl' by simp
              next
                show "γ ?trn = γ ?trn1" unfolding ss1 by simp
              next
                assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
              next
                have "Δ4 s' vl' s' ?vl1'" using cor1 PID' pPID' op' vl1 ss1 lul BC
                unfolding Δ4_def vl v ul vl' by auto
                thus "?Δ s' vl' s' ?vl1'" by simp
              qed
            qed(insert vl lul ul, auto)
          next
            case True note ul = True
            hence f: "f ?trn = OVal False" and vl': "vl' = vll"
            using vl c f φ unfolding consume_def ul by auto
            have op': "¬ open s'" using f_eq_OVal[OF step φ f] op by simp
            show ?thesis proof
              show "validTrans ?trn1" using step unfolding ss1 by simp
            next
              show "consume ?trn1 vl1 vll1" using ul φ c
              unfolding vl1 vl' vl ss1 consume_def by auto
            next
              show "γ ?trn = γ ?trn1" unfolding ss1 by simp
            next
              assume "γ ?trn" note γ = this
              thus "g ?trn = g ?trn1" unfolding ss1 by simp
            next
              have pPID': "post s' PID = post s PID"
              using step φ PID op op' f
              apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
                subgoal for x4 apply(cases x4) apply(auto simp: u_defs) .
                subgoal by auto
                subgoal by auto
                subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
              done
              show "?Δ s' vl' s' vll1" using BC proof cases
                case BC_PVal
                hence "Δ1 s' vl' s' vll1" using PID' pPID' op' cor1 BC lul
                unfolding Δ1_def vl1 ul ss1 vl' by auto
                thus ?thesis by simp
              next
                case (BC_BO Vll Vll1 Ul Ul1 Sul)
                show ?thesis proof(cases "Ul ≠ [] ∧ Ul1 ≠ []")
                  case True
                  hence "Δ31 s' vl' s' vll1" using PID' pPID' op' cor1 BC BC_BO lul
                  unfolding Δ31_def vl1 ul ss1 vl' apply simp
                  apply(rule exI[of _ Ul]) apply(rule exI[of _ Ul1])
                  apply(rule exI[of _ Sul])
                  apply(rule exI[of _ Vll]) apply(rule exI[of _ Vll1])
                  by auto
                  thus ?thesis by simp
                next
                  case False
                  hence 0: "Ul = []" "Ul1 = []" using BC_BO by auto
                  hence "Δ32 s' vl' s' vll1" using PID' pPID' op' cor1 BC BC_BO lul
                  unfolding Δ32_def vl1 ul ss1 vl' apply simp
                  apply(rule exI[of _ Sul])
                  apply(rule exI[of _ Vll]) apply(rule exI[of _ Vll1])
                  by auto
                  thus ?thesis by simp
                qed
              qed
            qed
          qed
        next
          case False note φ = False
          hence vl': "vl' = vl" using c unfolding consume_def by auto
          have pPID': "post s' PID = post s PID"
            using step φ PID op
            apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
                subgoal for x4 apply(cases x4) apply(auto simp: u_defs) .
                subgoal by auto
                subgoal by auto
                subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
            done
          have op': "open s'"
            using PID step φ op unfolding φ_def2[OF step] by (cases a) auto
          show ?thesis proof
            show "validTrans ?trn1" unfolding ss1 using step by simp
          next
            show "consume ?trn1 vl1 vl1" using φ unfolding ss1 consume_def vl' vl vl1 by simp
          next
            show "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            have "Δ4 s' vl' s' vl1" using cor1 PID' pPID' op' vl1 ss1 lul BC
            unfolding Δ4_def vl vl' by auto
            thus "?Δ s' vl' s' vl1" by simp
          qed
        qed
      thus ?thesis by simp
      qed
    qed
  thus ?thesis using vl by simp
  qed
qed

definition Gr where
"Gr =
 {
 (Δ0, {Δ0,Δ1,Δ2,Δ31,Δ32,Δ4}),
 (Δ1, {Δ1,Δ11}),
 (Δ11, {Δ11}),
 (Δ2, {Δ2}),
 (Δ31, {Δ31,Δ32}),
 (Δ32, {Δ2,Δ32,Δ4}),
 (Δ4, {Δ1,Δ31,Δ32,Δ4})
 }"


theorem secure: secure
apply (rule unwind_decomp_secure_graph[of Gr Δ0])
unfolding Gr_def
apply (simp, smt insert_subset order_refl)
using
istate_Δ0 unwind_cont_Δ0 unwind_cont_Δ1 unwind_cont_Δ11
unwind_cont_Δ31 unwind_cont_Δ32 unwind_cont_Δ2 unwind_cont_Δ4
unfolding Gr_def by auto




end

end
_RECEIVER

Theory Independent_Post_Observation_Setup_RECEIVER

(* Strengthened observation setup, customized for post confidentiality *)
theory Independent_Post_Observation_Setup_RECEIVER
  imports
    "../../Safety_Properties"
    "../Post_Observation_Setup_RECEIVER"
begin

subsubsection ‹Receiver observation setup›

locale Strong_ObservationSetup_RECEIVER = Fixed_UIDs + Fixed_PID + Fixed_AID
begin

(*  *)
fun γ :: "(state,act,out) trans ⇒ bool" where
"γ (Trans _ a _ _) ⟷
   (∃ uid. userOfA a = Some uid ∧ uid ∈ UIDs)
   ∨
   ― ‹Communication actions are considered to be observable in order to make the security
       properties compositional›
   (∃ca. a = COMact ca)
   ∨
   ― ‹The following actions are added to strengthen the observers in order to show that all
      posts ∗‹other than ‹PID› of ‹AID›› are completely independent of that post;  the
      confidentiality of the latter is protected even if the observers can see all updates to
      other posts (and actions contributing to the declassification triggers of those posts).›
   (∃uid p pid pst. a = Uact (uPost uid p pid pst))
   ∨
   (∃uid p. a = Sact (sSys uid p))
   ∨
   (∃uid p uid' p'. a = Cact (cUser uid p uid' p'))
   ∨
   (∃uid p pid. a = Cact (cPost uid p pid))
   ∨
   (∃uid p uid'. a = Cact (cFriend uid p uid'))
   ∨
   (∃uid p uid'. a = Dact (dFriend uid p uid'))
   ∨
   (∃uid p pid v. a = Uact (uVisPost uid p pid v))"

(* Note: the passwords don't really have to be purged (since identity theft is not
considered in the first place); however, purging passwords looks more sane. *)

(* Purging the password in starting actions: *)
fun sPurge :: "sActt ⇒ sActt" where
"sPurge (sSys uid pwd) = sSys uid emptyPass"

(* Purging communicating actions: user-password information is removed, and post content for PID
  is removed from the only kind of action that may contain such info: comReceivePost.
  Note: server-password info is not purged --todo: discuss this.  *)
fun comPurge :: "comActt ⇒ comActt" where
 "comPurge (comSendServerReq uID p aID reqInfo) = comSendServerReq uID emptyPass aID reqInfo"
|"comPurge (comConnectClient uID p aID sp) = comConnectClient uID emptyPass aID sp"
(* *)
|"comPurge (comReceivePost aID sp pID pst uID vs) =
  (let pst' = (if aID = AID ∧ pID = PID then emptyPost else pst)
   in comReceivePost aID sp pID pst' uID vs)"
(* *)
|"comPurge (comSendPost uID p aID pID) = comSendPost uID emptyPass aID pID"
|"comPurge (comSendCreateOFriend uID p aID uID') = comSendCreateOFriend uID emptyPass aID uID'"
|"comPurge (comSendDeleteOFriend uID p aID uID') = comSendDeleteOFriend uID emptyPass aID uID'"
|"comPurge ca = ca"

(* Note: No output purge here -- only for the issuer. *)

fun g :: "(state,act,out)trans ⇒ obs" where
 "g (Trans _ (Sact sa) ou _) = (Sact (sPurge sa), ou)"
|"g (Trans _ (COMact ca) ou _) = (COMact (comPurge ca), ou)"
|"g (Trans _ a ou _) = (a,ou)"

lemma comPurge_simps:
  "comPurge ca = comSendServerReq uID p aID reqInfo ⟷ (∃p'. ca = comSendServerReq uID p' aID reqInfo ∧ p = emptyPass)"
  "comPurge ca = comReceiveClientReq aID reqInfo ⟷ ca = comReceiveClientReq aID reqInfo"
  "comPurge ca = comConnectClient uID p aID sp ⟷ (∃p'. ca = comConnectClient uID p' aID sp ∧ p = emptyPass)"
  "comPurge ca = comConnectServer aID sp ⟷ ca = comConnectServer aID sp"
  "comPurge ca = comReceivePost aID sp pID pst' uID v ⟷ (∃pst. ca = comReceivePost aID sp pID pst uID v ∧ pst' = (if pID = PID ∧ aID = AID then emptyPost else pst))"
  "comPurge ca = comSendPost uID p aID pID ⟷ (∃p'. ca = comSendPost uID p' aID pID ∧ p = emptyPass)"
  "comPurge ca = comSendCreateOFriend uID p aID uID' ⟷ (∃p'. ca = comSendCreateOFriend uID p' aID uID' ∧ p = emptyPass)"
  "comPurge ca = comReceiveCreateOFriend aID cp uID uID' ⟷ ca = comReceiveCreateOFriend aID cp uID uID'"
  "comPurge ca = comSendDeleteOFriend uID p aID uID' ⟷ (∃p'. ca = comSendDeleteOFriend uID p' aID uID' ∧ p = emptyPass)"
  "comPurge ca = comReceiveDeleteOFriend aID cp uID uID' ⟷ ca = comReceiveDeleteOFriend aID cp uID uID'"
by (cases ca; auto)+

lemma g_simps:
  "g (Trans s a ou s') = (COMact (comSendServerReq uID p aID reqInfo), ou')
⟷ (∃p'. a = COMact (comSendServerReq uID p' aID reqInfo) ∧ p = emptyPass ∧ ou = ou')"
  "g (Trans s a ou s') = (COMact (comReceiveClientReq aID reqInfo), ou')
⟷ a = COMact (comReceiveClientReq aID reqInfo) ∧ ou = ou'"
  "g (Trans s a ou s') = (COMact (comConnectClient uID p aID sp), ou')
⟷ (∃p'. a = COMact (comConnectClient uID p' aID sp) ∧ p = emptyPass ∧ ou = ou')"
  "g (Trans s a ou s') = (COMact (comConnectServer aID sp), ou')
⟷ a = COMact (comConnectServer aID sp) ∧ ou = ou'"
  "g (Trans s a ou s') = (COMact (comReceivePost aID sp pID pst' uID v), ou')
⟷ (∃pst. a = COMact (comReceivePost aID sp pID pst uID v) ∧ pst' = (if pID = PID ∧ aID = AID then emptyPost else pst) ∧ ou = ou')"
   "g (Trans s a ou s') = (COMact (comSendPost uID p aID nID), O_sendPost (aid, sp, pid, pst, own, v))
⟷ (∃p'. a = COMact (comSendPost uID p' aID nID) ∧ p = emptyPass ∧ ou = O_sendPost (aid, sp, pid, pst, own, v))"
  "g (Trans s a ou s') = (COMact (comSendCreateOFriend uID p aID uID'), ou')
⟷ (∃p'. a = (COMact (comSendCreateOFriend uID p' aID uID')) ∧ p = emptyPass ∧ ou = ou')"
  "g (Trans s a ou s') = (COMact (comReceiveCreateOFriend aID cp uID uID'), ou')
⟷ a = COMact (comReceiveCreateOFriend aID cp uID uID') ∧ ou = ou'"
  "g (Trans s a ou s') = (COMact (comSendDeleteOFriend uID p aID uID'), ou')
⟷ (∃p'. a = COMact (comSendDeleteOFriend uID p' aID uID') ∧ p = emptyPass ∧ ou = ou')"
  "g (Trans s a ou s') = (COMact (comReceiveDeleteOFriend aID cp uID uID'), ou')
⟷ a = COMact (comReceiveDeleteOFriend aID cp uID uID') ∧ ou = ou'"
by (cases a; auto simp: comPurge_simps ObservationSetup_RECEIVER.comPurge.simps)+

end

end
VER

Theory Independent_Post_Value_Setup_RECEIVER

(* The value setup for paper confidentiality *)
theory Independent_Post_Value_Setup_RECEIVER
  imports
    "../../Safety_Properties"
    "Independent_Post_Observation_Setup_RECEIVER"
    "../Post_Unwinding_Helper_RECEIVER"
begin

subsubsection ‹Receiver value setup›

locale Post_RECEIVER = Strong_ObservationSetup_RECEIVER
begin

datatype "value" = PValR post
     (* post content received -- implicitly, this is from the api AID *)


fun φ :: "(state,act,out) trans ⇒ bool" where
"φ (Trans _ (COMact (comReceivePost aid sp pid pst uid vs)) ou _) =
(aid = AID ∧ pid = PID ∧ ou = outOK)"
|
"φ (Trans s _ _ s') = False"

lemma φ_def2:
(*assumes "step s a = (ou,s')"*)
shows
"φ (Trans s a ou s') ⟷
 (∃uid p pst vs. a = COMact (comReceivePost AID p PID pst uid vs) ∧ ou = outOK)"
(* using assms *)
by (cases "Trans s a ou s'" rule: φ.cases) auto

lemma comReceivePost_out:
assumes 1: "step s a = (ou,s')" and a: "a = COMact (comReceivePost AID p PID pst uid vs)" and 2: "ou = outOK"
shows "p = serverPass s AID"
using 1 2 unfolding a by (auto simp: com_defs)

lemma φ_def3:
assumes "step s a = (ou,s')"
shows
"φ (Trans s a ou s') ⟷
 (∃uid pst vs. a = COMact (comReceivePost AID (serverPass s AID) PID pst uid vs) ∧ ou = outOK)"
unfolding φ_def2(* [OF assms] *)
using comReceivePost_out[OF assms]
by blast

lemma φ_cases:
assumes "φ (Trans s a ou s')"
and "step s a = (ou, s')"
and "reach s"
obtains
  (Recv) uid sp aID pID pst vs where "a = COMact (comReceivePost aID sp pID pst uid vs)" "ou = outOK"
                                 "sp = serverPass s AID"
                                  "aID = AID" "pID = PID"
proof -
  from assms(1) obtain sp pst uid vs where "a = COMact (comReceivePost AID sp PID pst uid vs) ∧ ou = outOK"
    unfolding φ_def2(* [OF assms(2)] *) by auto
  then show thesis proof -
    assume "a = COMact (comReceivePost AID sp PID pst uid vs) ∧ ou = outOK"
    with assms(2) show thesis by (intro Recv) (auto simp: com_defs)
  qed
qed


fun f :: "(state,act,out) trans ⇒ value" where
"f (Trans s (COMact (comReceivePost aid sp pid pst uid vs)) _ s') =
 (if aid = AID ∧ pid = PID then PValR pst else undefined)"
|
"f (Trans s _ _ s') = undefined"


sublocale Receiver_State_Equivalence_Up_To_PID .

lemma eqButPID_step_φ_imp:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and φ: "φ (Trans s a ou s')"
shows "φ (Trans s1 a ou1 s1')"
proof-
  have s's1': "eqButPID s' s1'"
  using eqButPID_step local.step ss1 step1 by blast
  show ?thesis using step step1 φ
  using eqButPID_stateSelectors[OF ss1]
  unfolding φ_def2(* [OF step] φ_def2[OF step1] *)
  by (auto simp: u_defs com_defs)
qed

lemma eqButPID_step_φ:
assumes s's1': "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
shows "φ (Trans s a ou s') = φ (Trans s1 a ou1 s1')"
by (metis eqButPID_step_φ_imp eqButPID_sym assms)


end

end

Theory Independent_Post_RECEIVER

theory Independent_Post_RECEIVER
  imports
    "Independent_Post_Observation_Setup_RECEIVER"
    "Independent_Post_Value_Setup_RECEIVER"
    "Bounded_Deducibility_Security.Compositional_Reasoning"
begin

subsubsection ‹Receiver declassification bound›

context Post_RECEIVER
begin


fun T :: "(state,act,out) trans ⇒ bool" where
"T (Trans s a ou s') ⟷
 (∃ uid ∈ UIDs.
   uid ∈∈ userIDs s' ∧ PID ∈∈ outerPostIDs s' AID ∧
   (uid = admin s' ∨
    (AID,outerOwner s' AID PID) ∈∈ recvOuterFriendIDs s' uid ∨
    outerVis s' AID PID = PublicV))"

definition B :: "value list ⇒ value list ⇒ bool" where
"B vl vl1 ≡ length vl = length vl1"

sublocale BD_Security_IO where
istate = istate and step = step and
φ = φ and f = f and γ = γ and g = g and T = T and B = B
done

subsubsection ‹Receiver unwinding proof›

lemma reach_PublicV_imples_FriendV[simp]:
assumes "reach s"
and "vis s pID ≠ PublicV"
shows "vis s pID = FriendV"
using assms reach_vis by auto

lemma reachNT_state:
assumes "reachNT s"
shows
"¬ (∃ uid ∈ UIDs.
   uid ∈∈ userIDs s ∧ PID ∈∈ outerPostIDs s AID ∧
   (uid = admin s ∨
    (AID,outerOwner s AID PID) ∈∈ recvOuterFriendIDs s uid ∨
     outerVis s AID PID = PublicV))"
using assms proof induct
  case (Step trn) thus ?case
  by (cases trn) auto
qed (simp add: istate_def)


(* major *) lemma eqButPID_step_γ_out:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sT: "reachNT s" and T: "¬ T (Trans s a ou s')"
and s1: "reach s1"
and γ: "γ (Trans s a ou s')"
shows "ou = ou1"
proof-
  have s'T: "reachNT s'" using step sT T using reachNT_PairI by blast
  note op = reachNT_state[OF s'T]
  note [simp] = all_defs
  note s = reachNT_reach[OF sT]
  note willUse =
  step step1 γ
  op
  reach_vis[OF s]
  eqButPID_stateSelectors[OF ss1] (* eqButPID_postSelectors[OF ss1] *)
  eqButPID_actions[OF ss1]
  eqButPID_update[OF ss1] (* eqButPID_setTextPost[OF ss1] *) eqButPID_not_PID[OF ss1]
  show ?thesis
  proof (cases a)
    case (Sact x1)
    with willUse show ?thesis by (cases x1) auto
  next
    case (Cact x2)
    with willUse show ?thesis by (cases x2) auto
  next
    case (Dact x3)
    with willUse show ?thesis by (cases x3) auto
  next
    case (Uact x4)
    with willUse show ?thesis by (cases x4) auto
  next
    case (Ract x5)
    with willUse show ?thesis
    proof (cases x5)
      case (rOPost uid p aid pid)
      with Ract willUse show ?thesis by (cases "aid = AID ∧ pid = PID") auto
    qed auto
  next
    case (Lact x6)
    with willUse show ?thesis by (cases x6) auto
  next
    case (COMact x7)
    with willUse show ?thesis by (cases x7) auto
  qed
qed


definition Δ0 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ0 s vl s1 vl1 ≡
 ¬ AID ∈∈ serverApiIDs s ∧
 s = s1 ∧
 length vl = length vl1"

definition Δ1 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ1 s vl s1 vl1 ≡
 AID ∈∈ serverApiIDs s ∧
 eqButPID s s1 ∧
 length vl = length vl1"

lemma istate_Δ0:
assumes B: "B vl vl1"
shows "Δ0 istate vl istate vl1"
using assms unfolding Δ0_def B_def istate_def by auto

lemma unwind_cont_Δ0: "unwind_cont Δ0 {Δ0,Δ1}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ0 s vl s1 vl1 ∨ Δ1 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ0 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s" and l: "length vl = length vl1"
  and AID: "¬ AID ∈∈ serverApiIDs s"
  using reachNT_reach unfolding Δ0_def by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof-
        have φ: "¬ φ ?trn" using AID step unfolding φ_def2(* [OF step] *) by (auto simp: u_defs com_defs)
        hence vl': "vl' = vl" using c φ unfolding consume_def by simp
        have ?match proof(cases "∃ p. a = COMact (comConnectServer AID p) ∧ ou = outOK")
          case True
          then obtain p where a: "a = COMact (comConnectServer AID p)" and ou: "ou = outOK" by auto
          have AID': "AID ∈∈ serverApiIDs s'"
          using step AID unfolding a ou by (auto simp: com_defs)
          note uid = reachNT_state[OF rsT]
          show ?thesis proof
            show "validTrans ?trn1" unfolding ss1 using step by simp
          next
            show "consume ?trn1 vl1 vl1" using φ unfolding consume_def ss1 by auto
          next
            show "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            have "Δ1 s' vl' s' vl1" using l AID' c unfolding ss1 Δ1_def vl' by auto
            thus "?Δ s' vl' s' vl1" by simp
          qed
        next
          case False note a = False
          have AID': "¬ AID ∈∈ serverApiIDs s'"
            using step AID a
            apply(cases a)
            subgoal for x1 apply(cases x1) apply(fastforce simp: s_defs)+ .
            subgoal for x2 apply(cases x2) apply(fastforce simp: c_defs)+ .
            subgoal for x3 apply(cases x3) apply(fastforce simp: d_defs)+ .
            subgoal for x4 apply(cases x4) apply(fastforce simp: u_defs)+ .
            subgoal by auto
            subgoal by auto
            subgoal for x7 apply(cases x7) apply(fastforce simp: com_defs)+ .
            done
          show ?thesis proof
            show "validTrans ?trn1" unfolding ss1 using step by simp
          next
            show "consume ?trn1 vl1 vl1" using φ unfolding consume_def ss1 by auto
          next
            show "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
          next
            have "Δ0 s' vl' s' vl1" using a AID' l unfolding Δ0_def vl' ss1 by simp
            thus "?Δ s' vl' s' vl1" by simp
          qed
        qed
        thus ?thesis by simp
      qed
    qed
  thus ?thesis using l by auto
  qed
qed

lemma unwind_cont_Δ1: "unwind_cont Δ1 {Δ1}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ1 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Δ1 s vl s1 vl1"
  hence rs: "reach s" and ss1: "eqButPID s s1"
  and l: "length vl = length vl1" and AID: "AID ∈∈ serverApiIDs s"
  using reachNT_reach unfolding Δ1_def by auto
  have AID1: "AID ∈∈ serverApiIDs s1" using eqButPID_stateSelectors[OF ss1] AID by auto

  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof-
        have ?match proof(cases "∃ p pst uid vs. a = COMact (comReceivePost AID p PID pst uid vs) ∧ ou = outOK")
          case True
          then obtain p pst uid vs where
          a: "a = COMact (comReceivePost AID p PID pst uid vs)" and ou: "ou = outOK" by auto
          have p: "p = serverPass s AID" using comReceivePost_out[OF step a ou] .
          have p1: "p = serverPass s1 AID" using p ss1 eqButPID_stateSelectors by auto
          have φ: "φ ?trn" using a ou step φ_def2 by auto
          obtain v where vl: "vl = v # vl'" and f: "f ?trn = v"
          using c φ unfolding consume_def by (cases vl) auto
          have AID': "AID ∈∈ serverApiIDs s'" using step AID unfolding a ou by (auto simp: com_defs)
          note uid = reachNT_state[OF rsT]
          obtain v1 vl1' where vl1: "vl1 = v1 # vl1'" using l unfolding vl by (cases vl1) auto
          obtain pst1 where v1: "v1 = PValR pst1" by (cases v1) auto
          define a1 where a1: "a1 ≡ COMact (comReceivePost AID p PID pst1 uid vs)"
          obtain s1' where step1: "step s1 a1 = (outOK, s1')" using AID1 unfolding a1 p1 by (simp add: com_defs)
          have s's1': "eqButPID s' s1'" using comReceivePost_step_eqButPID[OF a _ step step1 ss1] a1 by simp
          let ?trn1 = "Trans s1 a1 outOK s1'"
          have φ1: "φ ?trn1" unfolding φ_def2(* [OF step1] *) unfolding a1 by auto
          have f1: "f ?trn1 = v1" unfolding a1 v1 by simp
          show ?thesis proof
            show "validTrans ?trn1" using step1 by simp
          next
            show "consume ?trn1 vl1 vl1'" using φ1 f1 unfolding consume_def ss1 vl1 by simp
          next
            show "γ ?trn = γ ?trn1" unfolding a a1 by simp
          next
            assume "γ ?trn" thus "g ?trn = g ?trn1" unfolding a a1 ou by simp
          next
            show "Δ1 s' vl' s1' vl1'" using l AID' c s's1' unfolding Δ1_def vl vl1 by simp
          qed
        next
          case False note a = False
          obtain s1' ou1 where step1: "step s1 a = (ou1, s1')" by fastforce
          let ?trn1 = "Trans s1 a ou1 s1'"
          have φ: "¬ φ ?trn" using a step φ_def2 by auto
          have φ1: "¬ φ ?trn1" using φ ss1 step step1 eqButPID_step_φ by blast
          have s's1': "eqButPID s' s1'" using ss1 step step1 eqButPID_step by blast
          have ouou1: "γ ?trn ⟹ ou = ou1" using eqButPID_step_γ_out ss1 step step1 T rs1 rsT by blast
          have AID': "AID ∈∈ serverApiIDs s'" using AID step rs using IDs_mono by auto
          have vl': "vl' = vl" using c φ unfolding consume_def by simp
          show ?thesis proof
            show "validTrans ?trn1" using step1 by simp
          next
            show "consume ?trn1 vl1 vl1" using φ1 unfolding consume_def ss1 by auto
          next
            show 1: "γ ?trn = γ ?trn1" unfolding ss1 by simp
          next
            assume "γ ?trn" hence "ou = ou1" using ouou1 by auto
            thus "g ?trn = g ?trn1" using ouou1 by (cases a) auto
          next
            show "Δ1 s' vl' s1' vl1" using a l s's1' AID' unfolding Δ1_def vl' by simp
          qed
        qed
        thus ?thesis by simp
      qed
    qed
  thus ?thesis using l by auto
  qed
qed

definition Gr where
"Gr =
 {
 (Δ0, {Δ0,Δ1}),
 (Δ1, {Δ1})
 }"


theorem Post_secure: secure
apply (rule unwind_decomp_secure_graph[of Gr Δ0])
unfolding Gr_def
apply (simp, smt insert_subset order_refl)
using istate_Δ0 unwind_cont_Δ0 unwind_cont_Δ1
unfolding Gr_def by auto


end (* context Post_RECEIVER *)

end
title>

Theory Independent_DYNAMIC_Post_Network

theory Independent_DYNAMIC_Post_Network
  imports
    "Independent_DYNAMIC_Post_ISSUER"
    "Independent_Post_RECEIVER"
    "../../API_Network"
    "BD_Security_Compositional.Composing_Security_Network"
begin

subsubsection ‹Confidentiality for the N-ary composition›

type_synonym ttrans = "(state, act, out) trans"
type_synonym obs = Post_Observation_Setup_ISSUER.obs
type_synonym "value" = "Post.value + Post_RECEIVER.value"

lemma value_cases:
fixes v :: "value"
obtains (PVal) pst where "v = Inl (Post.PVal pst)"
      | (PValS) aid pst where "v = Inl (Post.PValS aid pst)"
      | (OVal) ov where "v = Inl (Post.OVal ov)"
      | (PValR) pst where "v = Inr (Post_RECEIVER.PValR pst)"
proof (cases v)
  case (Inl vl) then show thesis using PVal PValS OVal by (cases vl rule: Post.value.exhaust) auto next
  case (Inr vr) then show thesis using PValR by (cases vr rule: Post_RECEIVER.value.exhaust) auto
qed

locale Post_Network = Network
+ fixes UIDs :: "apiID ⇒ userID set"
  and AID :: "apiID" and PID :: "postID"
  assumes AID_in_AIDs: "AID ∈ AIDs"
begin

sublocale Iss: Post "UIDs AID" PID .

abbreviation φ :: "apiID ⇒ (state, act, out) trans ⇒ bool"
where "φ aid trn ≡ (if aid = AID then Iss.φ trn else Post_RECEIVER.φ PID AID trn)"

abbreviation f :: "apiID ⇒ (state, act, out) trans ⇒ value"
where "f aid trn ≡ (if aid = AID then Inl (Iss.f trn) else Inr (Post_RECEIVER.f PID AID trn))"

abbreviation γ :: "apiID ⇒ (state, act, out) trans ⇒ bool"
where "γ aid trn ≡ (if aid = AID then Iss.γ trn else Strong_ObservationSetup_RECEIVER.γ (UIDs aid) trn)"

abbreviation g :: "apiID ⇒ (state, act, out) trans ⇒ obs"
where "g aid trn ≡ (if aid = AID then Iss.g trn else Strong_ObservationSetup_RECEIVER.g PID AID trn)"

abbreviation T :: "apiID ⇒ (state, act, out) trans ⇒ bool"
where "T aid trn ≡ (if aid = AID then Iss.T trn else Post_RECEIVER.T (UIDs aid) PID AID trn)"

abbreviation B :: "apiID ⇒ value list ⇒ value list ⇒ bool"
where "B aid vl vl1 ≡
  (if aid = AID then list_all isl vl ∧ list_all isl vl1 ∧ Iss.B (map projl vl) (map projl vl1)
   else list_all (Not o isl) vl ∧ list_all (Not o isl) vl1 ∧ Post_RECEIVER.B (map projr vl) (map projr vl1))"

fun comOfV :: "apiID ⇒ value ⇒ com" where
  "comOfV aid (Inl (Post.PValS aid' pst)) = (if aid' ≠ aid then Send else Internal)"
| "comOfV aid (Inl (Post.PVal pst)) = Internal"
| "comOfV aid (Inl (Post.OVal ov)) = Internal"
| "comOfV aid (Inr v) = Recv"

fun tgtNodeOfV :: "apiID ⇒ value ⇒ apiID" where
  "tgtNodeOfV aid (Inl (Post.PValS aid' pst)) = aid'"
| "tgtNodeOfV aid (Inl (Post.PVal pst)) = undefined"
| "tgtNodeOfV aid (Inl (Post.OVal ov)) = undefined"
| "tgtNodeOfV aid (Inr v) = AID"

definition syncV :: "apiID ⇒ value ⇒ apiID ⇒ value ⇒ bool" where
  "syncV aid1 v1 aid2 v2 =
    (∃pst. aid1 = AID ∧ v1 = Inl (Post.PValS aid2 pst) ∧ v2 = Inr (Post_RECEIVER.PValR pst))"

lemma syncVI: "syncV AID (Inl (Post.PValS aid' pst)) aid' (Inr (Post_RECEIVER.PValR pst))"
unfolding syncV_def by auto

lemma syncVE:
assumes "syncV aid1 v1 aid2 v2"
obtains pst where "aid1 = AID" "v1 = Inl (Post.PValS aid2 pst)" "v2 = Inr (Post_RECEIVER.PValR pst)"
using assms unfolding syncV_def by auto

fun getTgtV where
  "getTgtV (Inl (Post.PValS aid pst)) = Inr (Post_RECEIVER.PValR pst)"
| "getTgtV v = v"

lemma comOfV_AID:
  "comOfV AID v = Send ⟷ isl v ∧ Iss.isPValS (projl v) ∧ Iss.tgtAPI (projl v) ≠ AID"
  "comOfV AID v = Recv ⟷ Not (isl v)"
by (cases v rule: value_cases; auto)+

lemmas φ_defs = Post_RECEIVER.φ_def2 Iss.φ_def3

sublocale Net: BD_Security_TS_Network_getTgtV
where istate = "λ_. istate" and validTrans = validTrans and srcOf = "λ_. srcOf" and tgtOf = "λ_. tgtOf"
  and nodes = AIDs and comOf = comOf and tgtNodeOf = tgtNodeOf
  and sync = sync and φ = φ and f = f and γ = γ and g = g and T = T and B = B
  and comOfV = comOfV and tgtNodeOfV = tgtNodeOfV and syncV = syncV
  and comOfO = comOfO and tgtNodeOfO = tgtNodeOfO and syncO = syncO (*and cmpO = cmpO*)
  and source = AID and getTgtV = getTgtV
using AID_in_AIDs proof (unfold_locales, goal_cases)
  case (1 nid trn) then show ?case using Iss.validTrans_isCOMact_open[of trn] by (cases trn rule: Iss.φ.cases) (auto simp: φ_defs split: prod.splits) next
  case (2 nid trn) then show ?case using Iss.validTrans_isCOMact_open[of trn] by (cases trn rule: Iss.φ.cases) (auto simp: φ_defs split: prod.splits) next
  case (3 nid trn)
    interpret Sink: Post_RECEIVER "UIDs nid" PID AID .
    show ?case using 3 by (cases "(nid,trn)" rule: tgtNodeOf.cases) (auto split: prod.splits)
next
  case (4 nid trn)
    interpret Sink: Post_RECEIVER "UIDs nid" PID AID .
    show ?case using 4 by (cases "(nid,trn)" rule: tgtNodeOf.cases) (auto split: prod.splits)
next
  case (5 nid1 trn1 nid2 trn2)
    interpret Sink1: Post_RECEIVER "UIDs nid1" PID AID .
    interpret Sink2: Post_RECEIVER "UIDs nid2" PID AID .
    show ?case using 5 by (elim sync_cases) (auto intro: syncVI)
next
  case (6 nid1 trn1 nid2 trn2)
    interpret Sink1: Post_RECEIVER "UIDs nid1" PID AID .
    interpret Sink2: Post_RECEIVER "UIDs nid2" PID AID .
    show ?case using 6 by (elim sync_cases) auto
next
  case (7 nid1 trn1 nid2 trn2)
    interpret Sink1: Post_RECEIVER "UIDs nid1" PID AID .
    interpret Sink2: Post_RECEIVER "UIDs nid2" PID AID .
    show ?case using 7(2,4,6-10)
      using Iss.validTrans_isCOMact_open[OF 7(2)] Iss.validTrans_isCOMact_open[OF 7(4)]
      by (elim sync_cases) (auto split: prod.splits, auto simp: sendPost_def)
next
  case (8 nid1 trn1 nid2 trn2)
    interpret Sink1: Post_RECEIVER "UIDs nid1" PID AID .
    interpret Sink2: Post_RECEIVER "UIDs nid2" PID AID .
    show ?case using 8(2,4,6-10,11,12,13)
      apply (elim syncO_cases; cases trn1; cases trn2)
          apply (auto simp: Iss.g_simps Strong_ObservationSetup_RECEIVER.g_simps split: prod.splits)
      apply (auto simp: sendPost_def split: prod.splits elim: syncVE)[]
      done
next
  case (9 nid trn)
    then show ?case
      by (cases "(nid,trn)" rule: tgtNodeOf.cases)
         (auto simp: Strong_ObservationSetup_RECEIVER.γ.simps)
next
  case (10 nid trn) then show ?case by (cases trn) (auto simp: φ_defs)
next
  case (11 vSrc nid vn) then show ?case by (cases vSrc rule: value_cases) (auto simp: syncV_def)
next
  case (12 vSrc nid vn) then show ?case by (cases vSrc rule: value_cases) (auto simp: syncV_def)
qed

lemma list_all_Not_isl_projectSrcV: "list_all (Not o isl) (Net.projectSrcV aid vlSrc)"
proof (induction vlSrc)
  case (Cons vSrc vlSrc') then show ?case by (cases vSrc rule: value_cases) auto
qed auto

context
fixes AID' :: apiID
assumes AID': "AID' ∈ AIDs - {AID}"
begin

interpretation Recv: Post_RECEIVER "UIDs AID'" PID AID by unfold_locales

lemma Iss_BC_BO_tgtAPI:
shows "(Iss.BC vl vl1 ⟶ map Iss.tgtAPI (filter Iss.isPValS vl) =
                          map Iss.tgtAPI (filter Iss.isPValS vl1)) ∧
       (Iss.BO vl vl1 ⟶ map Iss.tgtAPI (filter Iss.isPValS vl) =
                          map Iss.tgtAPI (filter Iss.isPValS vl1))"
by (induction rule: Iss.BC_BO.induct) auto

lemma Iss_B_Recv_B_aux:
assumes "list_all isl vl"
and "list_all isl vl1"
and "map Iss.tgtAPI (filter Iss.isPValS (map projl vl)) =
     map Iss.tgtAPI (filter Iss.isPValS (map projl vl1))"
shows "length (map projr (Net.projectSrcV AID' vl)) = length (map projr (Net.projectSrcV AID' vl1))"
using assms proof (induction vl vl1 rule: list22_induct)
  case (ConsCons v vl v1 vl1)
    consider (SendSend) aid pst pst1 where "v = Inl (Iss.PValS aid pst)" "v1 = Inl (Iss.PValS aid pst1)"
           | (Internal) "comOfV AID v = Internal" "¬Iss.isPValS (projl v)"
           | (Internal1) "comOfV AID v1 = Internal" "¬Iss.isPValS (projl v1)"
      using ConsCons(4-6) by (cases v rule: value_cases; cases v1 rule: value_cases) auto
    then show ?case proof cases
      case (SendSend) then show ?thesis using ConsCons.IH(1) ConsCons.prems by auto
    next
      case (Internal) then show ?thesis using ConsCons.IH(2)[of "v1 # vl1"] ConsCons.prems by auto
    next
      case (Internal1) then show ?thesis using ConsCons.IH(3)[of "v # vl"] ConsCons.prems by auto
    qed
qed (auto simp: comOfV_AID)

lemma Iss_B_Recv_B:
assumes "B AID vl vl1"
shows "Recv.B (map projr (Net.projectSrcV AID' vl)) (map projr (Net.projectSrcV AID' vl1))"
using assms Iss_B_Recv_B_aux Iss_BC_BO_tgtAPI by (auto simp: Iss.B_def Recv.B_def)

end

lemma map_projl_Inl: "map (projl o Inl) vl = vl"
by (induction vl) auto

lemma these_map_Inl_projl: "list_all isl vl ⟹ these (map (Some o Inl o projl) vl) = vl"
by (induction vl) auto

lemma map_projr_Inr: "map (projr o Inr) vl = vl"
by (induction vl) auto

lemma these_map_Inr_projr: "list_all (Not o isl) vl ⟹ these (map (Some o Inr o projr) vl) = vl"
by (induction vl) auto

sublocale BD_Security_TS_Network_Preserve_Source_Security_getTgtV
where istate = "λ_. istate" and validTrans = validTrans and srcOf = "λ_. srcOf" and tgtOf = "λ_. tgtOf"
  and nodes = AIDs and comOf = comOf and tgtNodeOf = tgtNodeOf
  and sync = sync and φ = φ and f = f and γ = γ and g = g and T = T and B = B
  and comOfV = comOfV and tgtNodeOfV = tgtNodeOfV and syncV = syncV
  and comOfO = comOfO and tgtNodeOfO = tgtNodeOfO and syncO = syncO (*and cmpO = cmpO*)
  and source = AID and getTgtV = getTgtV
proof (unfold_locales, goal_cases)
  case 1 show ?case using AID_in_AIDs .
next
  case 2
    interpret Iss': BD_Security_TS_Trans
      istate System_Specification.validTrans srcOf tgtOf Iss.φ Iss.f Iss.γ Iss.g Iss.T Iss.B
      istate System_Specification.validTrans srcOf tgtOf Iss.φ "λtrn. Inl (Iss.f trn)" Iss.γ Iss.g Iss.T "B AID"
      id id Some "Some o Inl"
    proof (unfold_locales, goal_cases)
      case (11 vl' vl1' tr) then show ?case
        by (intro exI[of _ "map projl vl1'"]) (auto simp: map_projl_Inl these_map_Inl_projl)
    qed auto
    show ?case using Iss.secure Iss'.translate_secure by auto
next
  case (3 aid tr vl' vl1)
    then show ?case
      using Iss_B_Recv_B[of aid "(Net.lV AID tr)" vl1] list_all_Not_isl_projectSrcV
      by auto
qed

theorem secure: "secure"
proof (intro preserve_source_secure ballI)
  fix aid
  assume aid: "aid ∈ AIDs - {AID}"
  interpret Node: Post_RECEIVER "UIDs aid" PID AID .
  interpret Node': BD_Security_TS_Trans
    istate System_Specification.validTrans srcOf tgtOf Node.φ Node.f Node.γ Node.g Node.T Node.B
    istate System_Specification.validTrans srcOf tgtOf Node.φ "λtrn. Inr (Node.f trn)" Node.γ Node.g Node.T "B aid"
    id id Some "Some o Inr"
  proof (unfold_locales, goal_cases)
    case (11 vl' vl1' tr) then show ?case using aid
      by (intro exI[of _ "map projr vl1'"]) (auto simp: map_projr_Inr these_map_Inr_projr)
  qed auto
  show "Net.lsecure aid"
    using aid Node.Post_secure Node'.translate_secure by auto
qed

end  (* context Post_Network *)

end

Theory Independent_Posts_Network

theory Independent_Posts_Network
  imports
    "Independent_DYNAMIC_Post_Network"
    "BD_Security_Compositional.Independent_Secrets"
begin

subsubsection ‹Composition of confidentiality guarantees for different posts›

text ‹We combine ∗‹two› confidentiality guarantees for two different posts in arbitrary nodes of
the network.

For this purpose, we have strengthened the observation power of the security property for
individual posts to make all transitions that update ∗‹other› posts observable, as well as all
transitions that contribute to the state of the trigger (see the observation setup
theories).  This guarantees that the confidentiality of one post is independent of actions
affecting other posts, which will allow us to combine security guarantees for different posts.

We now prove a few helper lemmas establishing that now the observable transitions indeed
fully determine the state of the trigger.›

fun obsEffect :: "state ⇒ obs ⇒ state" where
  "obsEffect s (Uact (uPost uid p pid pst), ou) = updatePost s uid p pid pst"
| "obsEffect s (Uact (uVisPost uid p pid v), ou) = updateVisPost s uid p pid v"
| "obsEffect s (Sact (sSys uid p), ou) = startSys s uid p"
| "obsEffect s (Cact (cUser uid p uid' p'), ou) = createUser s uid p uid' p'"
| "obsEffect s (Cact (cPost uid p pid), ou) = createPost s uid p pid"
| "obsEffect s (Cact (cFriend uid p uid'), ou) = createFriend s uid p uid'"
| "obsEffect s (Dact (dFriend uid p uid'), ou) = deleteFriend s uid p uid'"
| "obsEffect s (COMact (comSendPost uid p aid pid), ou) = snd (sendPost s uid p aid pid)"
| "obsEffect s (COMact (comReceivePost aid p pid pst uid v), ou) = receivePost s aid p pid pst uid v"
| "obsEffect s (COMact (comReceiveCreateOFriend aid p uid uid'), ou) = receiveCreateOFriend s aid p uid uid'"
| "obsEffect s (COMact (comReceiveDeleteOFriend aid p uid uid'), ou) = receiveDeleteOFriend s aid p uid uid'"
| "obsEffect s _ = s"

fun obsStep :: "state ⇒ obs ⇒ state" where
  "obsStep s (a,ou) = (if ou ≠ outErr then obsEffect s (a,ou) else s)"

fun obsSteps :: "state ⇒ obs list ⇒ state" where
  "obsSteps s obsl = foldl obsStep s obsl"

definition triggerEq :: "state ⇒ state ⇒ bool" where
  "triggerEq s s' ⟷ userIDs s = userIDs s' ∧ postIDs s = postIDs s' ∧ admin s = admin s' ∧
                      owner s = owner s' ∧ friendIDs s = friendIDs s' ∧ vis s = vis s' ∧
                      outerPostIDs s = outerPostIDs s' ∧ outerOwner s = outerOwner s' ∧
                      recvOuterFriendIDs s = recvOuterFriendIDs s' ∧ outerVis s = outerVis s'"

lemma triggerEq_refl[simp]: "triggerEq s s"
and triggerEq_sym: "triggerEq s s' ⟹ triggerEq s' s"
and triggerEq_trans: "triggerEq s s' ⟹ triggerEq s' s'' ⟹ triggerEq s s''"
unfolding triggerEq_def by auto

no_notation relcomp (infixr "O" 75)

context Post
begin

lemma [simp]: "outOK = outPurge ou ⟷ ou = outOK" by (cases ou) auto
lemma [simp]: "sPurge sa = sSys (sUserOfA sa) emptyPass" by (cases sa) auto
lemma sStep_unfold: "sStep s sa = (if userIDs s = []
                                   then (case sa of sSys uid p ⇒ (outOK, startSys s uid p))
                                   else (outErr, s))"
by (cases sa) (auto simp: s_defs)

lemma triggerEq_open:
assumes "triggerEq s s'"
shows "open s ⟷ open s'"
using assms unfolding triggerEq_def open_def by auto

lemma triggerEq_not_γ:
assumes "validTrans (Trans s a ou s')" and "¬γ (Trans s a ou s')"
shows "triggerEq s s'"
proof (cases a)
  case (Sact sa) then show ?thesis using assms by (cases sa) (auto simp: triggerEq_def s_defs) next
  case (Cact ca) then show ?thesis using assms by (cases ca) (auto simp: triggerEq_def c_defs) next
  case (Dact da) then show ?thesis using assms by (cases da) (auto simp: triggerEq_def d_defs) next
  case (Uact ua) then show ?thesis using assms by (cases ua) (auto simp: triggerEq_def u_defs) next
  case (Ract ra) then show ?thesis using assms by (auto simp: triggerEq_def) next
  case (Lact ra) then show ?thesis using assms by (auto simp: triggerEq_def) next
  case (COMact ca) then show ?thesis using assms by (cases ca) (auto simp: triggerEq_def com_defs)
qed

lemma triggerEq_obsStep:
assumes "validTrans (Trans s a ou s')" and "γ (Trans s a ou s')" and "triggerEq s s1"
shows "triggerEq s' (obsStep s1 (g (Trans s a ou s')))"
proof (cases a)
  case (Sact sa) then show ?thesis using assms by (cases sa) (auto simp: triggerEq_def s_defs) next
  case (Cact ca) then show ?thesis using assms by (cases ca) (auto simp: triggerEq_def c_defs) next
  case (Dact da) then show ?thesis using assms by (cases da) (auto simp: triggerEq_def d_defs) next
  case (Uact ua) then show ?thesis using assms by (cases ua) (auto simp: triggerEq_def u_defs) next
  case (Ract ra) then show ?thesis using assms by (auto simp: triggerEq_def) next
  case (Lact ra) then show ?thesis using assms by (auto simp: triggerEq_def) next
  case (COMact ca) then show ?thesis using assms by (cases ca) (auto simp: triggerEq_def com_defs)
qed

lemma triggerEq_obsSteps:
assumes "validFrom s tr" and "triggerEq s s'"
shows "triggerEq (tgtOfTrFrom s tr) (obsSteps s' (O tr))"
using assms proof (induction tr arbitrary: s s')
  case (Nil s s')
  then show ?case by auto
next
  case (Cons trn tr s s')
  then obtain a ou s'' where trn: "trn = Trans s a ou s''" and step: "step s a = (ou, s'')"
    by (cases trn) (auto simp: validFrom_Cons)
  show ?case proof cases
    assume γ: "γ trn"
    then have "triggerEq s'' (obsStep s' (g trn))" unfolding trn using step Cons(3) by (auto intro: triggerEq_obsStep)
    with Cons.IH[OF _ this] Cons(2) γ trn show ?thesis by (auto simp: validFrom_Cons)
  next
    assume nγ: "¬ γ trn"
    then have "triggerEq s s''" using Cons(2) unfolding trn by (intro triggerEq_not_γ) (auto simp: validFrom_Cons)
    with Cons(3) have "triggerEq s'' s'" by (auto intro: triggerEq_sym triggerEq_trans)
    with Cons.IH[OF _ this] Cons(2) nγ trn show ?thesis by (auto simp: validFrom_Cons)
  qed
qed

end

context Post_RECEIVER
begin

lemma sPurge_simp[simp]: "sPurge sa = sSys (sUserOfA sa) emptyPass" by (cases sa) auto

definition "T_state s' ≡
(∃ uid ∈ UIDs.
   uid ∈∈ userIDs s' ∧ PID ∈∈ outerPostIDs s' AID ∧
   (uid = admin s' ∨
    (AID,outerOwner s' AID PID) ∈∈ recvOuterFriendIDs s' uid ∨
    outerVis s' AID PID = PublicV))"

lemma T_T_state: "T trn ⟷ T_state (tgtOf trn)"
by (cases trn) (auto simp: T_state_def)

lemma triggerEq_T:
assumes "triggerEq s s'"
shows "T_state s ⟷ T_state s'"
using assms unfolding triggerEq_def T_state_def by auto

lemma never_T_not_T_state:
assumes "validFrom s tr" and "never T tr" and "¬T_state s"
shows "¬T_state (tgtOfTrFrom s tr)"
using assms by (induction tr arbitrary: s rule: rev_induct) (auto simp: T_T_state)

lemma triggerEq_not_γ:
assumes "validTrans (Trans s a ou s')" and "¬γ (Trans s a ou s')"
shows "triggerEq s s'"
proof (cases a)
  case (Sact sa) then show ?thesis using assms by (cases sa) (auto simp: triggerEq_def s_defs) next
  case (Cact ca) then show ?thesis using assms by (cases ca) (auto simp: triggerEq_def c_defs) next
  case (Dact da) then show ?thesis using assms by (cases da) (auto simp: triggerEq_def d_defs) next
  case (Uact ua) then show ?thesis using assms by (cases ua) (auto simp: triggerEq_def u_defs) next
  case (Ract ra) then show ?thesis using assms by (auto simp: triggerEq_def) next
  case (Lact ra) then show ?thesis using assms by (auto simp: triggerEq_def) next
  case (COMact ca) then show ?thesis using assms by (cases ca) (auto simp: triggerEq_def com_defs)
qed

lemma triggerEq_obsStep:
assumes "validTrans (Trans s a ou s')" and "γ (Trans s a ou s')" and "triggerEq s s1"
shows "triggerEq s' (obsStep s1 (g (Trans s a ou s')))"
proof (cases a)
  case (Sact sa) then show ?thesis using assms by (cases sa) (auto simp: triggerEq_def s_defs) next
  case (Cact ca) then show ?thesis using assms by (cases ca) (auto simp: triggerEq_def c_defs) next
  case (Dact da) then show ?thesis using assms by (cases da) (auto simp: triggerEq_def d_defs) next
  case (Uact ua) then show ?thesis using assms by (cases ua) (auto simp: triggerEq_def u_defs) next
  case (Ract ra) then show ?thesis using assms by (auto simp: triggerEq_def) next
  case (Lact ra) then show ?thesis using assms by (auto simp: triggerEq_def) next
  case (COMact ca) then show ?thesis using assms by (cases ca) (auto simp: triggerEq_def com_defs)
qed


lemma triggerEq_obsSteps:
assumes "validFrom s tr" and "triggerEq s s'"
shows "triggerEq (tgtOfTrFrom s tr) (obsSteps s' (O tr))"
using assms proof (induction tr arbitrary: s s')
  case (Nil s s')
  then show ?case by auto
next
  case (Cons trn tr s s')
  then obtain a ou s'' where trn: "trn = Trans s a ou s''" and step: "step s a = (ou, s'')"
    by (cases trn) (auto simp: validFrom_Cons)
  show ?case proof cases
    assume γ: "γ trn"
    then have "triggerEq s'' (obsStep s' (g trn))" unfolding trn using step Cons(3) by (auto intro: triggerEq_obsStep)
    with Cons.IH[OF _ this] Cons(2) γ trn show ?thesis by (auto simp: validFrom_Cons)
  next
    assume nγ: "¬ γ trn"
    then have "triggerEq s s''" using Cons(2) unfolding trn by (intro triggerEq_not_γ) (auto simp: validFrom_Cons)
    with Cons(3) have "triggerEq s'' s'" by (auto intro: triggerEq_sym triggerEq_trans)
    with Cons.IH[OF _ this] Cons(2) nγ trn show ?thesis by (auto simp: validFrom_Cons)
  qed
qed

end

context Post_Network
begin

fun nObsStep :: "(apiID ⇒ state) ⇒ (apiID, act × out) nobs ⇒ (apiID ⇒ state)" where
  "nObsStep s (LObs aid obs) = s(aid := obsStep (s aid) obs)"
| "nObsStep s (CObs aid1 obs1 aid2 obs2) = s(aid1 := obsStep (s aid1) obs1, aid2 := obsStep (s aid2) obs2)"

fun nObsSteps :: "(apiID ⇒ state) ⇒ (apiID, act × out) nobs list ⇒ (apiID ⇒ state)" where
  "nObsSteps s obsl = foldl nObsStep s obsl"

definition nTriggerEq :: "(apiID ⇒ state) ⇒ (apiID ⇒ state) ⇒ bool" where
  "nTriggerEq s s' ⟷ (∀aid. triggerEq (s aid) (s' aid))"

lemma nTriggerEq_refl[simp]: "nTriggerEq s s"
and nTriggerEq_sym: "nTriggerEq s s' ⟹ nTriggerEq s' s"
and nTriggerEq_trans: "nTriggerEq s s' ⟹ nTriggerEq s' s'' ⟹ nTriggerEq s s''"
unfolding nTriggerEq_def by (auto intro: triggerEq_sym triggerEq_trans)

lemma nTriggerEq_open:
assumes "nTriggerEq s s'"
shows "∀aid. Iss.open (s aid) ⟷ Iss.open (s' aid)"
using assms unfolding nTriggerEq_def by (auto intro!: Iss.triggerEq_open)

lemma nTriggerEq_not_γ:
assumes "nValidTrans trn" and "¬Net.nγ trn"
shows "nTriggerEq (nSrcOf trn) (nTgtOf trn)"
proof (cases trn)
  case (LTrans s aid1 trn1)
  with assms show ?thesis using Iss.triggerEq_not_γ Post_RECEIVER.triggerEq_not_γ
    by (cases trn1) (auto simp: nTriggerEq_def)
next
  case (CTrans s aid1 trn1 aid2 trn2)
  with assms show ?thesis
    by (auto elim: sync_cases simp: Strong_ObservationSetup_RECEIVER.γ.simps Strong_ObservationSetup_ISSUER.γ.simps)
qed

lemma nTriggerEq_obsStep:
assumes "nValidTrans trn" and "Net.nγ trn" and "nTriggerEq (nSrcOf trn) s1"
shows "nTriggerEq (nTgtOf trn) (nObsStep s1 (Net.ng trn))"
unfolding nTriggerEq_def proof
  fix aid
  show "triggerEq (nTgtOf trn aid) (nObsStep s1 (Net.ng trn) aid)"
  proof (cases trn)
    case (LTrans s aid1 trn1)
    with assms show ?thesis unfolding nTriggerEq_def
      by (cases trn1) (auto intro: Iss.triggerEq_obsStep Post_RECEIVER.triggerEq_obsStep)
  next
    case (CTrans s aid1 trn1 aid2 trn2)
    then have "sync aid1 trn1 aid2 trn2" using assms by auto
    moreover obtain a1 ou1 s1' a2 ou2 s2'
    where "trn1 = Trans (s aid1) a1 ou1 s1'" and "trn2 = Trans (s aid2) a2 ou2 s2'"
      using CTrans assms by (cases trn1, cases trn2) auto
    ultimately show ?thesis using CTrans assms unfolding nTriggerEq_def
      using Iss.triggerEq_obsStep[of "s aid1" a1 ou1 s1' "s1 aid1"]
      using Iss.triggerEq_obsStep[of "s aid2" a2 ou2 s2' "s1 aid2"]
      using Post_RECEIVER.triggerEq_obsStep[of "s aid1" a1 ou1 s1' "UIDs aid1" "s1 aid1"]
      using Post_RECEIVER.triggerEq_obsStep[of "s aid2" a2 ou2 s2' "UIDs aid2" "s1 aid2"]
      by (elim sync_cases) (auto simp: Strong_ObservationSetup_RECEIVER.γ.simps)
  qed
qed

lemma triggerEq_obsSteps:
assumes "validFrom s tr" and "nTriggerEq s s'"
shows "nTriggerEq (nTgtOfTrFrom s tr) (nObsSteps s' (O tr))"
using assms proof (induction tr arbitrary: s s')
  case (Nil s s')
  then show ?case by auto
next
  case (Cons trn tr s s')
  have tr: "local.validFrom (nTgtOf trn) tr" "nTgtOfTrFrom s (trn # tr) = nTgtOfTrFrom (nTgtOf trn) tr"
    using Cons(2) by auto
  show ?case proof cases
    assume γ: "Net.nγ trn"
    then have O: "nObsSteps s' (O (trn # tr)) = nObsSteps (nObsStep s' (Net.ng trn)) (O tr)" by auto
    have "nTriggerEq (nTgtOf trn) (nObsStep s' (Net.ng trn))" using Cons(2,3) γ
      by (intro nTriggerEq_obsStep) auto
    from Cons.IH[OF tr(1) this] show ?thesis unfolding O tr(2) .
  next
    assume nγ: "¬ Net.nγ trn"
    then have O: "O (trn # tr) = O tr" by auto
    have "nTriggerEq (nSrcOf trn) (nTgtOf trn)" using nγ Cons(2) by (intro nTriggerEq_not_γ) auto
    with Cons(3) have "nTriggerEq (nTgtOf trn) s'" using Cons(2) by (auto intro: nTriggerEq_sym nTriggerEq_trans)
    from Cons.IH[OF tr(1) this] show ?thesis unfolding O tr(2) .
  qed
qed

lemma O_eq_nTriggerEq:
assumes O: "O tr = O tr'" and tr: "validFrom s (tr ## trn)" and tr': "validFrom s' (tr' ## trn')"
and γ: "Net.nγ trn" and γ': "Net.nγ trn'" and g: "Net.ng trn = Net.ng trn'"
and s_s': "nTriggerEq s s'"
shows "nTriggerEq (nSrcOf trn) (nSrcOf trn')" and "nTriggerEq (nTgtOf trn) (nTgtOf trn')"
proof -
  have *: "nTriggerEq (nTgtOfTrFrom s tr) (nObsSteps s' (O tr))" using tr s_s'
    by (intro triggerEq_obsSteps) auto
  have **: "nTriggerEq (nTgtOfTrFrom s' tr') (nObsSteps s' (O tr'))" using tr'
    by (intro triggerEq_obsSteps) auto
  from nTriggerEq_trans[OF *[unfolded O] **[THEN nTriggerEq_sym]]
  show src: "nTriggerEq (nSrcOf trn) (nSrcOf trn')" using tr tr'
    by (auto simp: nTgtOfTrFrom_nTgtOf_last)
  have "nTriggerEq (nTgtOf trn) (nObsStep (nSrcOf trn') (Net.ng trn))" using tr γ src
    by (intro nTriggerEq_obsStep) auto
  moreover have "nTriggerEq (nTgtOf trn') (nObsStep (nSrcOf trn') (Net.ng trn'))" using tr' γ'
    by (intro nTriggerEq_obsStep) auto
  ultimately show "nTriggerEq (nTgtOf trn) (nTgtOf trn')" unfolding g
    by (auto intro: nTriggerEq_sym nTriggerEq_trans)
qed

end


text ‹We are now ready to combine two confidentiality properties for different posts in different
nodes.›

locale Posts_Network =
  Post1: Post_Network AIDs UIDs AID1 PID1
+ Post2: Post_Network AIDs UIDs AID2 PID2
for AIDs :: "apiID set"
and UIDs :: "apiID ⇒ userID set"
and AID1 :: "apiID" and AID2 :: "apiID"
and PID1 :: "postID" and PID2 :: "postID"
+
assumes AID1_neq_AID2: "AID1 ≠ AID2"
begin

text ‹The combined observations consist of the local actions of observing users and their outputs,
as usual. We do not consider communication actions here for simplicity, because this would require
us to combine the ∗‹purgings› of observations of the two properties. This is straightforward, but
tedious.›

fun nγ :: "(apiID, state, (state, act, out) trans) ntrans ⇒ bool" where
  "nγ (LTrans s aid (Trans _ a _ _)) = (∃ uid. userOfA a = Some uid ∧ uid ∈ UIDs aid ∧ (¬isCOMact a))"
| "nγ (CTrans s aid1 trn1 aid2 trn2) = False"

fun g :: "(state,act,out) trans ⇒ obs" where
  "g (Trans _ (Sact sa) ou _) = (Sact (Post1.Iss.sPurge sa), ou)"
| "g (Trans _ a ou _) = (a,ou)"

fun ng :: "(apiID, state, (state, act, out) trans) ntrans ⇒ (apiID, act × out) nobs" where
  "ng (LTrans s aid trn) = LObs aid (g trn)"
| "ng (CTrans s aid1 trn1 aid2 trn2) = undefined"

abbreviation "validSystemTrace ≡ Post1.validFrom (λ_. istate)"

text ‹We now instantiate the generic technique for combining security properties with
independent secret sources.›

sublocale BD_Security_TS_Two_Secrets "λ_. istate" Post1.nValidTrans Post1.nSrcOf Post1.nTgtOf
  Post1.Net.nφ Post1.nf' Post1.Net.nγ Post1.Net.ng Post1.Net.nT "Post1.B AID1"
  Post2.Net.nφ Post2.nf' Post2.Net.nγ Post2.Net.ng Post2.Net.nT "Post2.B AID2"
  nγ ng
proof
  fix tr trn
  assume "nγ trn"
  then show "Post1.Net.nγ trn ∧ Post2.Net.nγ trn"
    by (cases trn rule: nγ.cases) (auto simp: Strong_ObservationSetup_RECEIVER.γ.simps)
next
  fix tr tr' trn trn'
  assume tr: "validSystemTrace (tr ## trn)" and tr': "validSystemTrace (tr' ## trn')"
     and γ: "Post1.Net.nγ trn" and γ': "Post1.Net.nγ trn'" and g: "Post1.Net.ng trn = Post1.Net.ng trn'"
  from tr tr' have trn: "Post1.nValidTrans trn" "Post1.nValidTrans trn'" by auto
  show "nγ trn = nγ trn'" proof (cases trn)
    case (LTrans s aid1 trn1)
    then obtain s' trn1' where trn': "trn' = LTrans s' aid1 trn1'" using g by (cases trn') auto
    then show ?thesis using LTrans g
      by (cases trn1 rule: Strong_ObservationSetup_ISSUER.g.cases;
          cases trn1' rule: Strong_ObservationSetup_ISSUER.g.cases)
         (auto simp: Strong_ObservationSetup_RECEIVER.g.simps Post_RECEIVER.sPurge_simp)
  next
    case (CTrans s aid1 trn1 aid2 trn2)
    then show ?thesis using g by (cases trn') auto
  qed
next
  fix tr tr' trn trn'
  assume O: "Post1.O tr = Post1.O tr'" and γ: "Post1.Net.nγ trn" "Post1.Net.nγ trn'"
     and tr: "validSystemTrace (tr ## trn)" and tr': "validSystemTrace (tr' ## trn')"
     and g: "Post1.Net.ng trn = Post1.Net.ng trn'" and γ: "nγ trn" and γ': "nγ trn'"
  then have trn: "Post1.nValidTrans trn" and trn': "Post1.nValidTrans trn'" by auto
  show "ng trn = ng trn'" proof (cases trn)
    case (LTrans s aid1 trn1)
    then obtain s' trn1' where "trn' = LTrans s' aid1 trn1'" using g by (cases trn') auto
    then show ?thesis using LTrans γ γ' g trn trn'
      by (cases "(aid1,trn1)" rule: Post1.tgtNodeOf.cases;
          cases "(aid1,trn1')" rule: Post1.tgtNodeOf.cases)
         (auto simp: Strong_ObservationSetup_RECEIVER.g.simps Post_RECEIVER.sPurge_simp
               simp: Post1.Iss.sStep_unfold split: sActt.splits)
  next
    case (CTrans s aid1 trn1 aid2 trn2)
    with γ show ?thesis by auto
  qed
next
  fix tr tr' trn trn'
  assume tr: "validSystemTrace (tr ## trn)" and tr': "validSystemTrace (tr' ## trn')"
     and γ: "Post2.Net.nγ trn" and γ': "Post2.Net.nγ trn'" and g: "Post2.Net.ng trn = Post2.Net.ng trn'"
  from tr tr' have trn: "Post1.nValidTrans trn" "Post1.nValidTrans trn'" by auto
  show "nγ trn = nγ trn'" proof (cases trn)
    case (LTrans s aid1 trn1)
    then obtain s' trn1' where trn': "trn' = LTrans s' aid1 trn1'" using g by (cases trn') auto
    then show ?thesis using LTrans g
      by (cases trn1 rule: Strong_ObservationSetup_ISSUER.g.cases;
          cases trn1' rule: Strong_ObservationSetup_ISSUER.g.cases)
         (auto simp: Strong_ObservationSetup_RECEIVER.g.simps Post_RECEIVER.sPurge_simp)
  next
    case (CTrans s aid1 trn1 aid2 trn2)
    then show ?thesis using g by (cases trn') auto
  qed
next
  fix tr tr' trn trn'
  assume O: "Post2.O tr = Post2.O tr'" and γ: "Post2.Net.nγ trn" "Post2.Net.nγ trn'"
     and tr: "validSystemTrace (tr ## trn)" and tr': "validSystemTrace (tr' ## trn')"
     and g: "Post2.Net.ng trn = Post2.Net.ng trn'" and γ: "nγ trn" and γ': "nγ trn'"
  then have trn: "Post1.nValidTrans trn" and trn': "Post1.nValidTrans trn'" by auto
  show "ng trn = ng trn'" proof (cases trn)
    case (LTrans s aid1 trn1)
    then obtain s' trn1' where "trn' = LTrans s' aid1 trn1'" using g by (cases trn') auto
    then show ?thesis using LTrans γ γ' g trn trn'
      by (cases "(aid1,trn1)" rule: Post1.tgtNodeOf.cases;
          cases "(aid1,trn1')" rule: Post1.tgtNodeOf.cases)
         (auto simp: Strong_ObservationSetup_RECEIVER.g.simps Post_RECEIVER.sPurge_simp
               simp: Post1.Iss.sStep_unfold split: sActt.splits)
  next
    case (CTrans s aid1 trn1 aid2 trn2)
    with γ show ?thesis by auto
  qed
next
  fix tr trn
  assume "validSystemTrace (tr ## trn)" and nφ: "Post2.Net.nφ trn"
  then have trn: "Post1.nValidTrans trn" by auto
  show "Post1.Net.nγ trn" proof (cases trn)
    case (LTrans s aid1 trn1)
    then obtain a ou s1' where trn1: "trn1 = Trans (s aid1) a ou s1'" using trn by (cases trn1) auto
    then show ?thesis using nφ trn LTrans AID1_neq_AID2
      using Post2.Iss.triggerEq_not_γ[THEN Post2.Iss.triggerEq_open]
      by (cases "Post2.Iss.γ trn1") (auto simp: Post2.φ_defs Strong_ObservationSetup_RECEIVER.γ.simps)
  next
    case (CTrans s aid1 trn1 aid2 trn2)
    with trn have "Post1.sync aid1 trn1 aid2 trn2" by auto
    then show ?thesis using trn CTrans
      by (elim Post1.sync_cases) (auto simp: Strong_ObservationSetup_RECEIVER.γ.simps)
  qed
next
  fix tr tr' trn trn'
  assume O: "Post1.O tr = Post1.O tr'" and γ: "Post1.Net.nγ trn" "Post1.Net.nγ trn'"
     and tr: "validSystemTrace (tr ## trn)" and tr': "validSystemTrace (tr' ## trn')"
     and g: "Post1.Net.ng trn = Post1.Net.ng trn'"
  have op: "∀aid. Post2.Iss.open (Post1.nSrcOf trn aid) ⟷ Post2.Iss.open (Post1.nSrcOf trn' aid)"
    using O γ tr tr' g by (intro Post2.nTriggerEq_open Post1.O_eq_nTriggerEq) auto
  have op': "∀aid. Post2.Iss.open (Post1.nTgtOf trn aid) ⟷ Post2.Iss.open (Post1.nTgtOf trn' aid)"
    using O γ tr tr' g by (intro Post2.nTriggerEq_open Post1.O_eq_nTriggerEq) auto
  have trn: "Post1.nValidTrans trn" and trn': "Post1.nValidTrans trn'" using tr tr' by auto
  show "Post2.Net.nφ trn = Post2.Net.nφ trn'"
  proof (cases trn)
    case (LTrans s aid1 trn1)
    then obtain s' trn1' where s': "trn' = LTrans s' aid1 trn1'" using g by (cases trn') auto
    moreover then have "srcOf trn1 = s aid1" "srcOf trn1' = s' aid1"
                       "tgtOf trn1 = Post1.nTgtOf trn aid1" "tgtOf trn1' = Post1.nTgtOf trn' aid1"
      using LTrans trn trn' by auto
    ultimately show ?thesis using LTrans op op' g AID1_neq_AID2
      by (cases trn1 rule: Post.φ.cases; cases trn1' rule: Post.φ.cases)
         (auto simp: Strong_ObservationSetup_RECEIVER.g.simps Strong_ObservationSetup_RECEIVER.comPurge.simps
                     Post.φ.simps Post_RECEIVER.φ.simps)
  next
    case (CTrans s aid1 trn1 aid2 trn2)
    then obtain s' trn1' trn2' where CTrans': "trn' = CTrans s' aid1 trn1' aid2 trn2'"
      using g by (cases trn') auto
    have "Post1.sync aid1 trn1 aid2 trn2" "Post1.sync aid1 trn1' aid2 trn2'"
      using CTrans CTrans' trn trn' by auto
    then show ?thesis using CTrans CTrans' trn trn' op op' g
      by (elim Post1.sync_cases)
         (auto simp: Post_RECEIVER.φ.simps Strong_ObservationSetup_RECEIVER.g.simps
                     Strong_ObservationSetup_RECEIVER.comPurge.simps)
  qed
next
  fix tr tr' trn trn'
  assume O: "Post1.O tr = Post1.O tr'" and γ: "Post1.Net.nγ trn" "Post1.Net.nγ trn'"
     and tr: "validSystemTrace (tr ## trn)" and tr': "validSystemTrace (tr' ## trn')"
     and g: "Post1.Net.ng trn = Post1.Net.ng trn'"
     and φ: "Post2.Net.nφ trn" and φ': "Post2.Net.nφ trn'"
  have op: "∀aid. Post2.Iss.open (Post1.nSrcOf trn aid) ⟷ Post2.Iss.open (Post1.nSrcOf trn' aid)"
    using O γ tr tr' g by (intro Post2.nTriggerEq_open Post1.O_eq_nTriggerEq) auto
  have op': "∀aid. Post2.Iss.open (Post1.nTgtOf trn aid) ⟷ Post2.Iss.open (Post1.nTgtOf trn' aid)"
    using O γ tr tr' g by (intro Post2.nTriggerEq_open Post1.O_eq_nTriggerEq) auto
  have trn: "Post1.nValidTrans trn" and trn': "Post1.nValidTrans trn'" using tr tr' by auto
  show "Post2.nf' trn = Post2.nf' trn'"
  proof (cases trn)
    case (LTrans s aid1 trn1)
    then obtain s' trn1' where s': "trn' = LTrans s' aid1 trn1'" using g by (cases trn') auto
    moreover then have "srcOf trn1 = s aid1" "srcOf trn1' = s' aid1"
                       "tgtOf trn1 = Post1.nTgtOf trn aid1" "tgtOf trn1' = Post1.nTgtOf trn' aid1"
      using LTrans trn trn' by auto
    ultimately show ?thesis using LTrans φ φ' op' g AID1_neq_AID2
      by (cases trn1 rule: Post.φ.cases; cases trn1' rule: Post.f.cases)
         (auto simp: Strong_ObservationSetup_RECEIVER.g.simps Strong_ObservationSetup_RECEIVER.comPurge.simps
                     Post.φ.simps Post_RECEIVER.φ.simps)
  next
    case (CTrans s aid1 trn1 aid2 trn2)
    then obtain s' trn1' trn2' where CTrans': "trn' = CTrans s' aid1 trn1' aid2 trn2'"
      using g by (cases trn') auto
    then have trn1: "validTrans trn1" and trn1': "validTrans trn1'" using trn trn' CTrans by auto
    have states: "tgtOf trn1 = Post1.nTgtOf trn aid1" "tgtOf trn2 = Post1.nTgtOf trn aid2"
                 "tgtOf trn1' = Post1.nTgtOf trn' aid1" "tgtOf trn2' = Post1.nTgtOf trn' aid2"
      using trn trn' CTrans CTrans' by auto
    have "Post1.sync aid1 trn1 aid2 trn2" "Post1.sync aid1 trn1' aid2 trn2'"
      using CTrans CTrans' trn trn' by auto
    then show ?thesis using CTrans CTrans' op' g states AID1_neq_AID2
      by (elim Post1.sync_cases[OF _ trn1] Post1.sync_cases[OF _ trn1'])
         (auto simp: Post_RECEIVER.φ.simps Strong_ObservationSetup_RECEIVER.g.simps
                     Strong_ObservationSetup_RECEIVER.comPurge.simps)
  qed
next
  fix tr trn
  assume "validSystemTrace (tr ## trn)" and nφ: "Post1.Net.nφ trn"
  then have trn: "Post1.nValidTrans trn" by auto
  show "Post2.Net.nγ trn" proof (cases trn)
    case (LTrans s aid1 trn1)
    then obtain a ou s1' where trn1: "trn1 = Trans (s aid1) a ou s1'" using trn by (cases trn1) auto
    then show ?thesis using nφ trn LTrans AID1_neq_AID2
      using Post1.Iss.triggerEq_not_γ[THEN Post1.Iss.triggerEq_open]
      by (cases "Post1.Iss.γ trn1") (auto simp: Post1.φ_defs Strong_ObservationSetup_RECEIVER.γ.simps)
  next
    case (CTrans s aid1 trn1 aid2 trn2)
    with trn have "Post1.sync aid1 trn1 aid2 trn2" by auto
    then show ?thesis
      using trn CTrans
      by (elim Post1.sync_cases) (auto simp: Strong_ObservationSetup_RECEIVER.γ.simps)
  qed
next
  fix tr tr' trn trn'
  assume O: "Post2.O tr = Post2.O tr'" and γ: "Post2.Net.nγ trn" "Post2.Net.nγ trn'"
     and tr: "validSystemTrace (tr ## trn)" and tr': "validSystemTrace (tr' ## trn')"
     and g: "Post2.Net.ng trn = Post2.Net.ng trn'"
  have op: "∀aid. Post1.Iss.open (Post1.nSrcOf trn aid) ⟷ Post1.Iss.open (Post1.nSrcOf trn' aid)"
    using O γ tr tr' g by (intro Post1.nTriggerEq_open Post2.O_eq_nTriggerEq) auto
  have op': "∀aid. Post1.Iss.open (Post1.nTgtOf trn aid) ⟷ Post1.Iss.open (Post1.nTgtOf trn' aid)"
    using O γ tr tr' g by (intro Post1.nTriggerEq_open Post2.O_eq_nTriggerEq) auto
  have trn: "Post1.nValidTrans trn" and trn': "Post1.nValidTrans trn'" using tr tr' by auto
  show "Post1.Net.nφ trn = Post1.Net.nφ trn'"
  proof (cases trn)
    case (LTrans s aid1 trn1)
    then obtain s' trn1' where s': "trn' = LTrans s' aid1 trn1'" using g by (cases trn') auto
    moreover then have "srcOf trn1 = s aid1" "srcOf trn1' = s' aid1"
                       "tgtOf trn1 = Post1.nTgtOf trn aid1" "tgtOf trn1' = Post1.nTgtOf trn' aid1"
      using LTrans trn trn' by auto
    ultimately show ?thesis using LTrans op op' g AID1_neq_AID2
      by (cases trn1 rule: Post.φ.cases; cases trn1' rule: Post.φ.cases)
         (auto simp: Strong_ObservationSetup_RECEIVER.g.simps Strong_ObservationSetup_RECEIVER.comPurge.simps
                     Post.φ.simps Post_RECEIVER.φ.simps)
  next
    case (CTrans s aid1 trn1 aid2 trn2)
    then obtain s' trn1' trn2' where CTrans': "trn' = CTrans s' aid1 trn1' aid2 trn2'"
      using g by (cases trn') auto
    have "Post1.sync aid1 trn1 aid2 trn2" "Post1.sync aid1 trn1' aid2 trn2'"
      using CTrans CTrans' trn trn' by auto
    then show ?thesis using CTrans CTrans' trn trn' op op' g
      by (elim Post1.sync_cases)
         (auto simp: Post_RECEIVER.φ.simps Strong_ObservationSetup_RECEIVER.g.simps
                     Strong_ObservationSetup_RECEIVER.comPurge.simps)
  qed
next
  fix tr tr' trn trn'
  assume O: "Post2.O tr = Post2.O tr'" and γ: "Post2.Net.nγ trn" "Post2.Net.nγ trn'"
     and tr: "validSystemTrace (tr ## trn)" and tr': "validSystemTrace (tr' ## trn')"
     and g: "Post2.Net.ng trn = Post2.Net.ng trn'"
     and φ: "Post1.Net.nφ trn" and φ': "Post1.Net.nφ trn'"
  have op: "∀aid. Post1.Iss.open (Post1.nSrcOf trn aid) ⟷ Post1.Iss.open (Post1.nSrcOf trn' aid)"
    using O γ tr tr' g by (intro Post1.nTriggerEq_open Post2.O_eq_nTriggerEq) auto
  have op': "∀aid. Post1.Iss.open (Post1.nTgtOf trn aid) ⟷ Post1.Iss.open (Post1.nTgtOf trn' aid)"
    using O γ tr tr' g by (intro Post1.nTriggerEq_open Post2.O_eq_nTriggerEq) auto
  have trn: "Post1.nValidTrans trn" and trn': "Post1.nValidTrans trn'" using tr tr' by auto
  show "Post1.nf' trn = Post1.nf' trn'"
  proof (cases trn)
    case (LTrans s aid1 trn1)
    then obtain s' trn1' where s': "trn' = LTrans s' aid1 trn1'" using g by (cases trn') auto
    moreover then have "srcOf trn1 = s aid1" "srcOf trn1' = s' aid1"
                       "tgtOf trn1 = Post1.nTgtOf trn aid1" "tgtOf trn1' = Post1.nTgtOf trn' aid1"
      using LTrans trn trn' by auto
    ultimately show ?thesis using LTrans φ φ' op' g AID1_neq_AID2
      by (cases trn1 rule: Post.φ.cases; cases trn1' rule: Post.f.cases)
         (auto simp: Strong_ObservationSetup_RECEIVER.g.simps Strong_ObservationSetup_RECEIVER.comPurge.simps
                     Post.φ.simps Post_RECEIVER.φ.simps)
  next
    case (CTrans s aid1 trn1 aid2 trn2)
    then obtain s' trn1' trn2' where CTrans': "trn' = CTrans s' aid1 trn1' aid2 trn2'"
      using g by (cases trn') auto
    then have trn1: "validTrans trn1" and trn1': "validTrans trn1'" using trn trn' CTrans by auto
    have states: "tgtOf trn1 = Post1.nTgtOf trn aid1" "tgtOf trn2 = Post1.nTgtOf trn aid2"
                 "tgtOf trn1' = Post1.nTgtOf trn' aid1" "tgtOf trn2' = Post1.nTgtOf trn' aid2"
      using trn trn' CTrans CTrans' by auto
    have "Post1.sync aid1 trn1 aid2 trn2" "Post1.sync aid1 trn1' aid2 trn2'"
      using CTrans CTrans' trn trn' by auto
    then show ?thesis using CTrans CTrans' op' g states AID1_neq_AID2
      by (elim Post1.sync_cases[OF _ trn1] Post1.sync_cases[OF _ trn1'])
         (auto simp: Post_RECEIVER.φ.simps Strong_ObservationSetup_RECEIVER.g.simps
                     Strong_ObservationSetup_RECEIVER.comPurge.simps)
  qed
next
  fix tr trn
  assume nT_trn: "Post2.Net.nT trn" and tr: "validSystemTrace (tr ## trn)"
     and nT_tr: "never Post2.Net.nT tr"
  show "Post1.Net.nγ trn" proof (cases trn)
    case (CTrans s aid1 trn1 aid2 trn2)
    then have "Post1.sync aid1 trn1 aid2 trn2" using tr by auto
    then show ?thesis using tr CTrans
      by (elim Post1.sync_cases) (auto simp: Strong_ObservationSetup_RECEIVER.γ.simps)
  next
    case (LTrans s aid1 trn1)
    then obtain a ou s1' where trn1: "trn1 = Trans (s aid1) a ou s1'" using tr by (cases trn1) auto
    interpret R: Post_RECEIVER "UIDs aid1" PID2 AID2 .
    interpret R': Post_RECEIVER "UIDs aid1" PID1 AID1 .
    from nT_trn have aid1: "aid1 ≠ AID2" and Ttgt: "R.T_state s1'"
      using LTrans R.T_T_state trn1 by auto
    have decomp_tr: "Post1.Iss.validFrom istate (Post1.decomp (tr ## trn) aid1)"
      using LTrans tr Post1.validFrom_lValidFrom[of "λ_. istate"] by auto
    then have s_aid1: "s aid1 = tgtOfTrFrom istate (Post1.decomp tr aid1)"
      using LTrans trn1 unfolding Post1.decomp_append
      by (auto simp: Post1.Iss.validFrom_Cons Post1.Iss.validFrom_append)
    have "¬R.T_state (s aid1)" unfolding s_aid1 proof (intro R.never_T_not_T_state)
      show "Post1.Iss.validFrom istate (Post1.decomp tr aid1)" using decomp_tr
        unfolding Post1.decomp_append by (auto simp: Post1.Iss.validFrom_append)
      show "never R.T (Post1.decomp tr aid1)" using aid1 Post2.Net.nTT_TT[OF nT_tr, of aid1] by auto
      show "¬ R.T_state istate" unfolding istate_def R.T_state_def by auto
    qed
    then have s_s1': "¬triggerEq (s aid1) s1'" using Ttgt by (auto simp: triggerEq_def R.T_state_def)
    show ?thesis proof (cases "aid1 = AID1")
      case True
      then show ?thesis using s_s1' Post1.Iss.triggerEq_not_γ tr unfolding trn1 LTrans
        by (cases "Post1.Iss.γ (Trans (s aid1) a ou s1')") auto
    next
      case False
      then show ?thesis using s_s1' R'.triggerEq_not_γ tr unfolding trn1 LTrans
        by (cases "R'.γ (Trans (s aid1) a ou s1')") auto
    qed
  qed
next
  fix tr tr' trn trn'
  assume O: "Post1.O tr = Post1.O tr'" and γ: "Post1.Net.nγ trn" "Post1.Net.nγ trn'"
     and tr: "validSystemTrace (tr ## trn)" and tr': "validSystemTrace (tr' ## trn')"
     and g: "Post1.Net.ng trn = Post1.Net.ng trn'"
  have op': "Post1.nTriggerEq (Post1.nTgtOf trn) (Post1.nTgtOf trn')"
    using O γ tr tr' g by (intro Post1.O_eq_nTriggerEq) auto
  have trn: "Post1.nValidTrans trn" and trn': "Post1.nValidTrans trn'" using tr tr' by auto
  show "Post2.Net.nT trn = Post2.Net.nT trn'" proof (cases trn)
    case (LTrans s aid1 trn1)
    moreover then obtain s' trn1' where LTrans': "trn' = LTrans s' aid1 trn1'"
      using g by (cases trn') auto
    ultimately have t: "triggerEq (tgtOf trn1) (tgtOf trn1')" using op' unfolding Post1.nTriggerEq_def
      by auto
    interpret R: Post_RECEIVER "UIDs aid1" PID2 AID2 .
    from t have "R.T_state (tgtOf trn1) ⟷ R.T_state (tgtOf trn1')" by (intro R.triggerEq_T)
    then show ?thesis using LTrans LTrans' by (auto simp: R.T_T_state)
  next
    case (CTrans s aid1 trn1 aid2 trn2)
    moreover then obtain s' trn1' trn2' where CTrans': "trn' = CTrans s' aid1 trn1' aid2 trn2'"
      using g by (cases trn') auto
    moreover then have "aid1 ≠ aid2" using trn' by auto
    ultimately have t: "triggerEq (tgtOf trn1) (tgtOf trn1')" "triggerEq (tgtOf trn2) (tgtOf trn2')"
      using op' unfolding Post1.nTriggerEq_def by auto
    interpret R1: Post_RECEIVER "UIDs aid1" PID2 AID2 .
    interpret R2: Post_RECEIVER "UIDs aid2" PID2 AID2 .
    from t have "R1.T_state (tgtOf trn1) ⟷ R1.T_state (tgtOf trn1')"
                "R2.T_state (tgtOf trn2) ⟷ R2.T_state (tgtOf trn2')"
      by (auto intro!: R1.triggerEq_T R2.triggerEq_T)
    then show ?thesis using CTrans CTrans' by (auto simp: R1.T_T_state R2.T_T_state)
  qed
qed

theorem two_posts_secure:
  "secure"
  using Post1.secure Post2.secure
  by (rule two_secure)

end

end

Theory Post_All

theory Post_All
imports
Post_COMPOSE2
Post_Network
DYNAMIC_Post_COMPOSE2
DYNAMIC_Post_Network
"Independent_Posts/Independent_Posts_Network"
begin


end
dy>

Theory Friend_Intro

theory Friend_Intro
  imports "../Safety_Properties"
begin

section ‹Friendship status confidentiality›

text ‹\label{sec:friend}
We verify the following property:

\ \\
Given a coalition consisting of groups of users ‹UIDs j› from multiple nodes ‹j›
and given two users ‹UID1› and ‹UID2› at some node ‹i› who are not in these groups,

the coalition cannot learn anything about the changes in the status
of friendship between ‹UID1› and ‹UID2›

beyond what everybody knows, namely that
  ▪ there is no friendship between them before those users have been created, and
  ▪ the updates form an alternating sequence of friending and unfriending,

and beyond those updates performed while or last before
a user in the group ‹UIDs i› is friends with ‹UID1› or ‹UID2›.

\ \\
The approach to proving this is similar to that for post confidentiality (explained
in the introduction of the post confidentiality section~\ref{sec:post}), but conceptually simpler
since here secret information is not communicated between different nodes (so we
don't need to distinguish between an issuer node and the other, receiver nodes).

Moreover, here we do not consider static versions of the bounds, but go directly for
the dynamic ones. Also, we prove directly the BD security for a network of ‹n› nodes,
omitting the case of two nodes.

Note that, unlike for post confidentiality, here remote friendship plays
no role in the statement of the property. This is because, in CoSMeDis, the listing
of a user's friends is only available to local (same-node) friends of that user,
and not to the remote (outer) friends.
›

end
/head>

Theory Friend_Observation_Setup

theory Friend_Observation_Setup
  imports Friend_Intro
begin

subsection ‹Observation setup›

(* *)
type_synonym obs = "act * out"

locale FriendObservationSetup =
  fixes UIDs :: "userID set" ― ‹local group of observers at a given node›
begin

(*  *)
fun γ :: "(state,act,out) trans ⇒ bool" where
"γ (Trans _ a _ _) = (∃ uid. userOfA a = Some uid ∧ uid ∈ UIDs ∨ (∃ca. a = COMact ca))"

fun g :: "(state,act,out)trans ⇒ obs" where
"g (Trans _ a ou _) = (a,ou)"

end

locale FriendNetworkObservationSetup =
  fixes UIDs :: "apiID ⇒ userID set" ― ‹groups of observers at different nodes›
begin

(*  *)
abbreviation γ :: "apiID ⇒ (state,act,out) trans ⇒ bool" where
"γ aid trn ≡ FriendObservationSetup.γ (UIDs aid) trn"

abbreviation g :: "apiID ⇒ (state,act,out)trans ⇒ obs" where
"g aid trn ≡ FriendObservationSetup.g trn"

end

end
/title>

Theory Friend_State_Indistinguishability

(* The state equivalence used for the unwinding proofs for the friendship confidentiality
   properties *)
theory Friend_State_Indistinguishability
  imports "Friend_Observation_Setup"
begin

subsection ‹Unwinding helper definitions and lemmas›

(* The secret: One will be interested in the friendship information of two arbitary,
   but fixed users UID1 and UID2 *)
locale Friend = FriendObservationSetup +
fixes
  UID1 :: userID
and
  UID2 :: userID
assumes
  UID1_UID2_UIDs: "{UID1,UID2} ∩ UIDs = {}"
and
  UID1_UID2: "UID1 ≠ UID2"
begin

(* The notion of two userID lists being equal save for at most one occurrence of uid: *)
fun eqButUIDl :: "userID ⇒ userID list ⇒ userID list ⇒ bool" where
"eqButUIDl uid uidl uidl1 = (remove1 uid uidl = remove1 uid uidl1)"

lemma eqButUIDl_eq[simp,intro!]: "eqButUIDl uid uidl uidl"
by auto

lemma eqButUIDl_sym:
assumes "eqButUIDl uid uidl uidl1"
shows "eqButUIDl uid uidl1 uidl"
using assms by auto

lemma eqButUIDl_trans:
assumes "eqButUIDl uid uidl uidl1" and "eqButUIDl uid uidl1 uidl2"
shows "eqButUIDl uid uidl uidl2"
using assms by auto

lemma eqButUIDl_remove1_cong:
assumes "eqButUIDl uid uidl uidl1"
shows "eqButUIDl uid (remove1 uid' uidl) (remove1 uid' uidl1)"
proof -
  have "remove1 uid (remove1 uid' uidl) = remove1 uid' (remove1 uid uidl)" by (simp add: remove1_commute)
  also have "… = remove1 uid' (remove1 uid uidl1)" using assms by simp
  also have "… = remove1 uid (remove1 uid' uidl1)" by (simp add: remove1_commute)
  finally show ?thesis by simp
qed

lemma eqButUIDl_snoc_cong:
assumes "eqButUIDl uid uidl uidl1"
and "uid' ∈∈ uidl ⟷ uid' ∈∈ uidl1"
shows "eqButUIDl uid (uidl ## uid') (uidl1 ## uid')"
using assms by (auto simp add: remove1_append remove1_idem)

(* The notion of two functions each taking a userID and returning a list of user IDs
  being equal everywhere but on UID1 and UID2, where their return results are allowed
  to be eqButUIDl : *)
definition eqButUIDf where
"eqButUIDf frds frds1 ≡
  eqButUIDl UID2 (frds UID1) (frds1 UID1)
∧ eqButUIDl UID1 (frds UID2) (frds1 UID2)
∧ (∀uid. uid ≠ UID1 ∧ uid ≠ UID2 ⟶ frds uid = frds1 uid)"

lemmas eqButUIDf_intro = eqButUIDf_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eqButUIDf_eeq[simp,intro!]: "eqButUIDf frds frds"
unfolding eqButUIDf_def by auto

lemma eqButUIDf_sym:
assumes "eqButUIDf frds frds1" shows "eqButUIDf frds1 frds"
using assms eqButUIDl_sym unfolding eqButUIDf_def
by presburger

lemma eqButUIDf_trans:
assumes "eqButUIDf frds frds1" and "eqButUIDf frds1 frds2"
shows "eqButUIDf frds frds2"
using assms eqButUIDl_trans unfolding eqButUIDf_def by (auto split: if_splits)

lemma eqButUIDf_cong:
assumes "eqButUIDf frds frds1"
and "uid = UID1 ⟹ eqButUIDl UID2 uu uu1"
and "uid = UID2 ⟹ eqButUIDl UID1 uu uu1"
and "uid ≠ UID1 ⟹ uid ≠ UID2 ⟹ uu = uu1"
shows "eqButUIDf (frds (uid := uu)) (frds1(uid := uu1))"
using assms unfolding eqButUIDf_def by (auto split: if_splits)

lemma eqButUIDf_eqButUIDl:
assumes "eqButUIDf frds frds1"
shows "eqButUIDl UID2 (frds UID1) (frds1 UID1)"
  and "eqButUIDl UID1 (frds UID2) (frds1 UID2)"
using assms unfolding eqButUIDf_def by (auto split: if_splits)

lemma eqButUIDf_not_UID:
"⟦eqButUIDf frds frds1; uid ≠ UID1; uid ≠ UID2⟧ ⟹ frds uid = frds1 uid"
unfolding eqButUIDf_def by (auto split: if_splits)

lemma eqButUIDf_not_UID':
assumes eq1: "eqButUIDf frds frds1"
and uid: "(uid,uid') ∉ {(UID1,UID2), (UID2,UID1)}"
shows "uid ∈∈ frds uid' ⟷ uid ∈∈ frds1 uid'"
proof -
  from uid have "(uid' = UID1 ∧ uid ≠ UID2)
               ∨ (uid' = UID2 ∧ uid ≠ UID1)
               ∨ (uid' ∉ {UID1,UID2})" (is "?u1 ∨ ?u2 ∨ ?n12")
    by auto
  then show ?thesis proof (elim disjE)
    assume "?u1"
    moreover then have "uid ∈∈ remove1 UID2 (frds uid') ⟷ uid ∈∈ remove1 UID2 (frds1 uid')"
      using eq1 unfolding eqButUIDf_def by auto
    ultimately show ?thesis by auto
  next
    assume "?u2"
    moreover then have "uid ∈∈ remove1 UID1 (frds uid') ⟷ uid ∈∈ remove1 UID1 (frds1 uid')"
      using eq1 unfolding eqButUIDf_def by auto
    ultimately show ?thesis by auto
  next
    assume "?n12"
    then show ?thesis using eq1 unfolding eqButUIDf_def by auto
  qed
qed

(* The notion of two functions each taking two userID arguments being
  equal everywhere but on the values (UID1,UID2) and (UID2,UID1): *)
definition eqButUID12 where
"eqButUID12 freq freq1 ≡
 ∀ uid uid'. if (uid,uid') ∈ {(UID1,UID2), (UID2,UID1)} then True else freq uid uid' = freq1 uid uid'"

lemmas eqButUID12_intro = eqButUID12_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eqButUID12_eeq[simp,intro!]: "eqButUID12 freq freq"
unfolding eqButUID12_def by auto

lemma eqButUID12_sym:
assumes "eqButUID12 freq freq1" shows "eqButUID12 freq1 freq"
using assms unfolding eqButUID12_def
by presburger

lemma eqButUID12_trans:
assumes "eqButUID12 freq freq1" and "eqButUID12 freq1 freq2"
shows "eqButUID12 freq freq2"
using assms unfolding eqButUID12_def by (auto split: if_splits)

lemma eqButUID12_cong:
assumes "eqButUID12 freq freq1"
(*and "uid = UID1 ⟹ eqButUID2 uu uu1"*)
and "¬ (uid,uid') ∈ {(UID1,UID2), (UID2,UID1)} ⟹ uu = uu1"
shows "eqButUID12 (fun_upd2 freq uid uid' uu) (fun_upd2 freq1 uid uid' uu1)"
using assms unfolding eqButUID12_def fun_upd2_def by (auto split: if_splits)

lemma eqButUID12_not_UID:
"⟦eqButUID12 freq freq1; ¬ (uid,uid') ∈ {(UID1,UID2), (UID2,UID1)}⟧ ⟹ freq uid uid' = freq1 uid uid'"
unfolding eqButUID12_def by (auto split: if_splits)


(* The notion of two states being equal everywhere but on the friendship requests or status of users UID1 and UID2: *)
definition eqButUID :: "state ⇒ state ⇒ bool" where
"eqButUID s s1 ≡
 admin s = admin s1 ∧

 pendingUReqs s = pendingUReqs s1 ∧ userReq s = userReq s1 ∧
 userIDs s = userIDs s1 ∧ user s = user s1 ∧ pass s = pass s1 ∧

 eqButUIDf (pendingFReqs s) (pendingFReqs s1) ∧
 eqButUID12 (friendReq s) (friendReq s1) ∧
 eqButUIDf (friendIDs s) (friendIDs s1) ∧

 postIDs s = postIDs s1 ∧ admin s = admin s1 ∧
 post s = post s1 ∧ vis s = vis s1 ∧
 owner s = owner s1 ∧

 pendingSApiReqs s = pendingSApiReqs s1 ∧ sApiReq s = sApiReq s1 ∧
 serverApiIDs s = serverApiIDs s1 ∧ serverPass s = serverPass s1 ∧
 outerPostIDs s = outerPostIDs s1 ∧ outerPost s = outerPost s1 ∧ outerVis s = outerVis s1 ∧
 outerOwner s = outerOwner s1 ∧
 sentOuterFriendIDs s = sentOuterFriendIDs s1 ∧
 recvOuterFriendIDs s = recvOuterFriendIDs s1 ∧

 pendingCApiReqs s = pendingCApiReqs s1 ∧ cApiReq s = cApiReq s1 ∧
 clientApiIDs s = clientApiIDs s1 ∧ clientPass s = clientPass s1 ∧
 sharedWith s = sharedWith s1"

lemmas eqButUID_intro = eqButUID_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eqButUID_refl[simp,intro!]: "eqButUID s s"
unfolding eqButUID_def by auto

lemma eqButUID_sym[sym]:
assumes "eqButUID s s1" shows "eqButUID s1 s"
using assms eqButUIDf_sym eqButUID12_sym unfolding eqButUID_def by auto

lemma eqButUID_trans[trans]:
assumes "eqButUID s s1" and "eqButUID s1 s2" shows "eqButUID s s2"
using assms eqButUIDf_trans eqButUID12_trans unfolding eqButUID_def by metis

(* Implications from eqButUID, including w.r.t. auxiliary operations: *)
lemma eqButUID_stateSelectors:
assumes "eqButUID s s1"
shows "admin s = admin s1"
"pendingUReqs s = pendingUReqs s1" "userReq s = userReq s1"
"userIDs s = userIDs s1" "user s = user s1" "pass s = pass s1"
"eqButUIDf (pendingFReqs s) (pendingFReqs s1)"
"eqButUID12 (friendReq s) (friendReq s1)"
"eqButUIDf (friendIDs s) (friendIDs s1)"

"postIDs s = postIDs s1"
"post s = post s1" "vis s = vis s1"
"owner s = owner s1"

"pendingSApiReqs s = pendingSApiReqs s1" "sApiReq s = sApiReq s1"
"serverApiIDs s = serverApiIDs s1" "serverPass s = serverPass s1"
"outerPostIDs s = outerPostIDs s1" "outerPost s = outerPost s1" "outerVis s = outerVis s1"
"outerOwner s = outerOwner s1"
"sentOuterFriendIDs s = sentOuterFriendIDs s1"
"recvOuterFriendIDs s = recvOuterFriendIDs s1"

"pendingCApiReqs s = pendingCApiReqs s1" "cApiReq s = cApiReq s1"
"clientApiIDs s = clientApiIDs s1" "clientPass s = clientPass s1"
"sharedWith s = sharedWith s1"

"IDsOK s = IDsOK s1"
using assms unfolding eqButUID_def IDsOK_def[abs_def] by auto

lemma eqButUID_eqButUID2:
"eqButUID s s1 ⟹ eqButUIDl UID2 (friendIDs s UID1) (friendIDs s1 UID1)"
unfolding eqButUID_def using eqButUIDf_eqButUIDl
by (smt eqButUIDf_eqButUIDl eqButUIDl.simps)

lemma eqButUID_not_UID:
"eqButUID s s1 ⟹ uid ≠ UID ⟹ post s uid = post s1 uid"
unfolding eqButUID_def by auto


lemma eqButUID_cong[simp, intro]:
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇admin := uu1⦈) (s1 ⦇admin := uu2⦈)"

"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇pendingUReqs := uu1⦈) (s1 ⦇pendingUReqs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇userReq := uu1⦈) (s1 ⦇userReq := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇userIDs := uu1⦈) (s1 ⦇userIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇user := uu1⦈) (s1 ⦇user := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇pass := uu1⦈) (s1 ⦇pass := uu2⦈)"

"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇postIDs := uu1⦈) (s1 ⦇postIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇owner := uu1⦈) (s1 ⦇owner := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇post := uu1⦈) (s1 ⦇post := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇vis := uu1⦈) (s1 ⦇vis := uu2⦈)"

"⋀ uu1 uu2. eqButUID s s1 ⟹ eqButUIDf uu1 uu2 ⟹ eqButUID (s ⦇pendingFReqs := uu1⦈) (s1 ⦇pendingFReqs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ eqButUID12 uu1 uu2 ⟹ eqButUID (s ⦇friendReq := uu1⦈) (s1 ⦇friendReq := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ eqButUIDf uu1 uu2 ⟹ eqButUID (s ⦇friendIDs := uu1⦈) (s1 ⦇friendIDs := uu2⦈)"

"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇pendingSApiReqs := uu1⦈) (s1 ⦇pendingSApiReqs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇sApiReq := uu1⦈) (s1 ⦇sApiReq := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇serverApiIDs := uu1⦈) (s1 ⦇serverApiIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇serverPass := uu1⦈) (s1 ⦇serverPass := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇outerPostIDs := uu1⦈) (s1 ⦇outerPostIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇outerPost := uu1⦈) (s1 ⦇outerPost := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇outerVis := uu1⦈) (s1 ⦇outerVis := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇outerOwner := uu1⦈) (s1 ⦇outerOwner := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇sentOuterFriendIDs := uu1⦈) (s1 ⦇sentOuterFriendIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇recvOuterFriendIDs := uu1⦈) (s1 ⦇recvOuterFriendIDs := uu2⦈)"

"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇pendingCApiReqs := uu1⦈) (s1 ⦇pendingCApiReqs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇cApiReq := uu1⦈) (s1 ⦇cApiReq := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇clientApiIDs := uu1⦈) (s1 ⦇clientApiIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇clientPass := uu1⦈) (s1 ⦇clientPass := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇sharedWith := uu1⦈) (s1 ⦇sharedWith:= uu2⦈)"
unfolding eqButUID_def by auto

definition "friends12" :: "state ⇒ bool"
where "friends12 s ≡ UID1 ∈∈ friendIDs s UID2 ∧ UID2 ∈∈ friendIDs s UID1"

lemma step_friendIDs:
assumes "step s a = (ou, s')"
and "a ≠ Cact (cFriend uid (pass s uid) uid') ∧ a ≠ Cact (cFriend uid' (pass s uid') uid) ∧
     a ≠ Dact (dFriend uid (pass s uid) uid') ∧ a ≠ Dact (dFriend uid' (pass s uid') uid)"
shows "uid ∈∈ friendIDs s' uid' ⟷ uid ∈∈ friendIDs s uid'" (is ?uid)
  and "uid' ∈∈ friendIDs s' uid ⟷ uid' ∈∈ friendIDs s uid" (is ?uid')
proof -
  from assms have "?uid ∧ ?uid'"
  proof (cases a)
    case (Sact sa) then show ?thesis using assms by (cases sa) (auto simp: s_defs) next
    case (Uact ua) then show ?thesis using assms by (cases ua) (auto simp: u_defs) next
    case (COMact ca) then show ?thesis using assms by (cases ca) (auto simp: com_defs) next
    case (Cact ca) then show ?thesis using assms by (cases ca) (auto simp: c_defs) next
    case (Dact da) then show ?thesis using assms by (cases da) (auto simp: d_defs)
  qed auto
  then show ?uid and ?uid' by auto
qed

lemma step_friends12:
assumes "step s a = (ou, s')"
and "a ≠ Cact (cFriend UID1 (pass s UID1) UID2) ∧ a ≠ Cact (cFriend UID2 (pass s UID2) UID1) ∧
     a ≠ Dact (dFriend UID1 (pass s UID1) UID2) ∧ a ≠ Dact (dFriend UID2 (pass s UID2) UID1)"
shows "friends12 s' ⟷ friends12 s"
using step_friendIDs[OF assms] unfolding friends12_def by auto

lemma step_pendingFReqs:
assumes step: "step s a = (ou, s')"
and "∀req. a ≠ Cact (cFriend uid (pass s uid) uid') ∧ a ≠ Cact (cFriend uid' (pass s uid') uid) ∧
           a ≠ Dact (dFriend uid (pass s uid) uid') ∧ a ≠ Dact (dFriend uid' (pass s uid') uid) ∧
           a ≠ Cact (cFriendReq uid (pass s uid) uid' req) ∧
           a ≠ Cact (cFriendReq uid' (pass s uid') uid req)"
shows "uid ∈∈ pendingFReqs s' uid' ⟷ uid ∈∈ pendingFReqs s uid'" (is ?uid)
  and "uid' ∈∈ pendingFReqs s' uid ⟷ uid' ∈∈ pendingFReqs s uid" (is ?uid')
proof -
  from assms have "?uid ∧ ?uid'"
  proof (cases a)
    case (Sact sa) then show ?thesis using assms by (cases sa) (auto simp: s_defs) next
    case (Uact ua) then show ?thesis using assms by (cases ua) (auto simp: u_defs) next
    case (COMact ca) then show ?thesis using assms by (cases ca) (auto simp: com_defs) next
    case (Cact ca) then show ?thesis using assms proof (cases ca)
      case (cFriend uid1 p uid1')
        then have "((uid1 = uid ⟶ uid1' ≠ uid') ∧ (uid1 = uid' ⟶ uid1' ≠ uid)) ∨ ou = outErr"
          using Cact assms by (auto simp: c_defs)
        then show ?thesis using step Cact cFriend by (auto simp: c_defs)
    qed (auto simp: c_defs) next
    case (Dact da) then show ?thesis using assms by (cases da) (auto simp: d_defs)
  qed auto
  then show ?uid and ?uid' by auto
qed

lemma eqButUID_friends12_set_friendIDs_eq:
assumes ss1: "eqButUID s s1"
and f12: "friends12 s = friends12 s1"
and rs: "reach s" and rs1: "reach s1"
shows "set (friendIDs s uid) = set (friendIDs s1 uid)"
proof -
  have dfIDs: "distinct (friendIDs s uid)" "distinct (friendIDs s1 uid)"
    using reach_distinct_friends_reqs[OF rs] reach_distinct_friends_reqs[OF rs1] by auto
  from f12 have uid12: "UID1 ∈∈ friendIDs s UID2 ⟷ UID1 ∈∈ friendIDs s1 UID2"
                       "UID2 ∈∈ friendIDs s UID1 ⟷ UID2 ∈∈ friendIDs s1 UID1"
    using reach_friendIDs_symmetric[OF rs] reach_friendIDs_symmetric[OF rs1]
    unfolding friends12_def by auto
  from ss1 have fIDs: "eqButUIDf (friendIDs s) (friendIDs s1)" unfolding eqButUID_def by simp
  show "set (friendIDs s uid) = set (friendIDs s1 uid)"
  proof (intro equalityI subsetI)
    fix uid'
    assume "uid' ∈∈ friendIDs s uid"
    then show "uid' ∈∈ friendIDs s1 uid"
      using fIDs dfIDs uid12 eqButUIDf_not_UID' unfolding eqButUIDf_def
      by (metis (no_types, lifting) insert_iff prod.inject singletonD)
  next
    fix uid'
    assume "uid' ∈∈ friendIDs s1 uid"
    then show "uid' ∈∈ friendIDs s uid"
      using fIDs dfIDs uid12 eqButUIDf_not_UID' unfolding eqButUIDf_def
      by (metis (no_types, lifting) insert_iff prod.inject singletonD)
  qed
qed


lemma distinct_remove1_idem: "distinct xs ⟹ remove1 y (remove1 y xs) = remove1 y xs"
by (induction xs) (auto simp add: remove1_idem)

lemma Cact_cFriend_step_eqButUID:
assumes step: "step s (Cact (cFriend uid p uid')) = (ou,s')"
and s: "reach s"
and uids: "(uid = UID1 ∧ uid' = UID2) ∨ (uid = UID2 ∧ uid' = UID1)" (is "?u12 ∨ ?u21")
shows "eqButUID s s'"
using assms proof (cases)
  assume ou: "ou = outOK"
  then have "uid' ∈∈ pendingFReqs s uid" using step by (auto simp add: c_defs)
  then have fIDs: "uid' ∉ set (friendIDs s uid)" "uid ∉ set (friendIDs s uid')"
        and fRs: "distinct (pendingFReqs s uid)" "distinct (pendingFReqs s uid')"
    using reach_distinct_friends_reqs[OF s] by auto
  have "eqButUIDf (friendIDs s) (friendIDs (createFriend s uid p uid'))"
    using fIDs uids UID1_UID2 unfolding eqButUIDf_def
    by (cases "?u12") (auto simp add: c_defs remove1_idem remove1_append)
  moreover have "eqButUIDf (pendingFReqs s) (pendingFReqs (createFriend s uid p uid'))"
    using fRs uids UID1_UID2 unfolding eqButUIDf_def
    by (cases "?u12") (auto simp add: c_defs distinct_remove1_idem)
  moreover have "eqButUID12 (friendReq s) (friendReq (createFriend s uid p uid'))"
    using uids unfolding eqButUID12_def
    by (auto simp add: c_defs fun_upd2_eq_but_a_b)
  ultimately show "eqButUID s s'" using step ou unfolding eqButUID_def by (auto simp add: c_defs)
qed (auto)

lemma Cact_cFriendReq_step_eqButUID:
assumes step: "step s (Cact (cFriendReq uid p uid' req)) = (ou,s')"
and uids: "(uid = UID1 ∧ uid' = UID2) ∨ (uid = UID2 ∧ uid' = UID1)" (is "?u12 ∨ ?u21")
shows "eqButUID s s'"
using assms proof (cases)
  assume ou: "ou = outOK"
  then have "uid ∉ set (pendingFReqs s uid')" "uid ∉ set (friendIDs s uid')"
    using step by (auto simp add: c_defs)
  then have "eqButUIDf (pendingFReqs s) (pendingFReqs (createFriendReq s uid p uid' req))"
    using uids UID1_UID2 unfolding eqButUIDf_def
    by (cases "?u12") (auto simp add: c_defs remove1_idem remove1_append)
  moreover have "eqButUID12 (friendReq s) (friendReq (createFriendReq s uid p uid' req))"
    using uids unfolding eqButUID12_def
    by (auto simp add: c_defs fun_upd2_eq_but_a_b)
  ultimately show "eqButUID s s'" using step ou unfolding eqButUID_def by (auto simp add: c_defs)
qed (auto)


lemma Dact_dFriend_step_eqButUID:
assumes step: "step s (Dact (dFriend uid p uid')) = (ou,s')"
and s: "reach s"
and uids: "(uid = UID1 ∧ uid' = UID2) ∨ (uid = UID2 ∧ uid' = UID1)" (is "?u12 ∨ ?u21")
shows "eqButUID s s'"
using assms proof (cases)
  assume ou: "ou = outOK"
  then have "uid' ∈∈ friendIDs s uid" using step by (auto simp add: d_defs)
  then have fRs: "distinct (friendIDs s uid)" "distinct (friendIDs s uid')"
    using reach_distinct_friends_reqs[OF s] by auto
  have "eqButUIDf (friendIDs s) (friendIDs (deleteFriend s uid p uid'))"
    using fRs uids UID1_UID2 unfolding eqButUIDf_def
    by (cases "?u12") (auto simp add: d_defs remove1_idem distinct_remove1_removeAll)
  then show "eqButUID s s'" using step ou unfolding eqButUID_def by (auto simp add: d_defs)
qed (auto)


(* major *) lemma eqButUID_step:
assumes ss1: "eqButUID s s1"
and step: "step s a = (ou,s')"
and step1: "step s1 a = (ou1,s1')"
and rs: "reach s"
and rs1: "reach s1"
shows "eqButUID s' s1'"
proof -
  note simps = eqButUID_stateSelectors s_defs c_defs u_defs r_defs l_defs com_defs
  from assms show ?thesis proof (cases a)
    case (Sact sa) with assms show ?thesis by (cases sa) (auto simp add: simps)
  next
    case (Cact ca) note a = this
      with assms show ?thesis proof (cases ca)
        case (cFriendReq uid p uid' req) note ca = this
          then show ?thesis
          proof (cases "(uid = UID1 ∧ uid' = UID2) ∨ (uid = UID2 ∧ uid' = UID1)")
            case True
              then have "eqButUID s s'" and "eqButUID s1 s1'"
                using step step1 unfolding a ca
                by (auto intro: Cact_cFriendReq_step_eqButUID)
              with ss1 show "eqButUID s' s1'" by (auto intro: eqButUID_sym eqButUID_trans)
          next
            case False
              have fRs: "eqButUIDf (pendingFReqs s) (pendingFReqs s1)"
               and fIDs: "eqButUIDf (friendIDs s) (friendIDs s1)" using ss1 by (auto simp: simps)
              then have uid_uid': "uid ∈∈ pendingFReqs s uid' ⟷ uid ∈∈ pendingFReqs s1 uid'"
                                  "uid ∈∈ friendIDs s uid' ⟷ uid ∈∈ friendIDs s1 uid'"
                using False by (auto intro!: eqButUIDf_not_UID')
              have "eqButUIDf ((pendingFReqs s)(uid' := pendingFReqs s uid' ## uid))
                              ((pendingFReqs s1)(uid' := pendingFReqs s1 uid' ## uid))"
                using fRs False
                by (intro eqButUIDf_cong) (auto simp add: remove1_append remove1_idem eqButUIDf_def)
              moreover have "eqButUID12 (fun_upd2 (friendReq s) uid uid' req)
                                        (fun_upd2 (friendReq s1) uid uid' req)"
                using ss1 by (intro eqButUID12_cong) (auto simp: simps)
              moreover have "e_createFriendReq s uid p uid' req
                         ⟷ e_createFriendReq s1 uid p uid' req"
                using uid_uid' ss1 by (auto simp: simps)
              ultimately show ?thesis using assms unfolding a ca by (auto simp: simps)
          qed
      next
        case (cFriend uid p uid') note ca = this
          then show ?thesis
          proof (cases "(uid = UID1 ∧ uid' = UID2) ∨ (uid = UID2 ∧ uid' = UID1)")
            case True
              then have "eqButUID s s'" and "eqButUID s1 s1'"
                using step step1 rs rs1 unfolding a ca
                by (auto intro!: Cact_cFriend_step_eqButUID)+
              with ss1 show "eqButUID s' s1'" by (auto intro: eqButUID_sym eqButUID_trans)
          next
            case False
              have fRs: "eqButUIDf (pendingFReqs s) (pendingFReqs s1)"
                    (is "eqButUIDf (?pfr s) (?pfr s1)")
               and fIDs: "eqButUIDf (friendIDs s) (friendIDs s1)" using ss1 by (auto simp: simps)
              then have uid_uid': "uid ∈∈ pendingFReqs s uid' ⟷ uid ∈∈ pendingFReqs s1 uid'"
                                  "uid' ∈∈ pendingFReqs s uid ⟷ uid' ∈∈ pendingFReqs s1 uid"
                                  "uid ∈∈ friendIDs s uid' ⟷ uid ∈∈ friendIDs s1 uid'"
                                  "uid' ∈∈ friendIDs s uid ⟷ uid' ∈∈ friendIDs s1 uid"
                using False by (auto intro!: eqButUIDf_not_UID')
              have "eqButUIDl UID1 (remove1 uid' (?pfr s UID2)) (remove1 uid' (?pfr s1 UID2))"
               and "eqButUIDl UID2 (remove1 uid' (?pfr s UID1)) (remove1 uid' (?pfr s1 UID1))"
               and "eqButUIDl UID1 (remove1 uid (?pfr s UID2)) (remove1 uid (?pfr s1 UID2))"
               and "eqButUIDl UID2 (remove1 uid (?pfr s UID1)) (remove1 uid (?pfr s1 UID1))"
               using fRs unfolding eqButUIDf_def
               by (auto intro!: eqButUIDl_remove1_cong simp del: eqButUIDl.simps)
              then have 1: "eqButUIDf ((?pfr s)(uid := remove1 uid' (?pfr s uid),
                                                uid' := remove1 uid (?pfr s uid')))
                                     ((?pfr s1)(uid := remove1 uid' (?pfr s1 uid),
                                                uid' := remove1 uid (?pfr s1 uid')))"
                using fRs False
                by (intro eqButUIDf_cong) (auto simp add: eqButUIDf_def)
              have "uid = UID1 ⟹ eqButUIDl UID2 (friendIDs s UID1 ## uid') (friendIDs s1 UID1 ## uid')"
               and "uid = UID2 ⟹ eqButUIDl UID1 (friendIDs s UID2 ## uid') (friendIDs s1 UID2 ## uid')"
               and "uid' = UID1 ⟹ eqButUIDl UID2 (friendIDs s UID1 ## uid) (friendIDs s1 UID1 ## uid)"
               and "uid' = UID2 ⟹ eqButUIDl UID1 (friendIDs s UID2 ## uid) (friendIDs s1 UID2 ## uid)"
                using fIDs uid_uid' by - (intro eqButUIDl_snoc_cong; simp add: eqButUIDf_def)+
              then have 2: "eqButUIDf ((friendIDs s)(uid := friendIDs s uid ## uid',
                                                      uid' := friendIDs s uid' ## uid))
                                       ((friendIDs s1)(uid := friendIDs s1 uid ## uid',
                                                       uid' := friendIDs s1 uid' ## uid))"
                using fIDs by (intro eqButUIDf_cong) (auto simp add: eqButUIDf_def)
              have 3: "eqButUID12 (fun_upd2 (fun_upd2 (friendReq s) uid' uid emptyRequestInfo)
                                                                    uid uid' emptyRequestInfo)
                                  (fun_upd2 (fun_upd2 (friendReq s1) uid' uid emptyRequestInfo)
                                                                     uid uid' emptyRequestInfo)"
                using ss1 by (intro eqButUID12_cong) (auto simp: simps)
              have "e_createFriend s uid p uid'
                ⟷ e_createFriend s1 uid p uid'"
                using uid_uid' ss1 by (auto simp: simps)
              with 1 2 3 show ?thesis using assms unfolding a ca by (auto simp: simps)
          qed
      qed (auto simp: simps)
  next
    case (Uact ua) with assms show ?thesis by (cases ua) (auto simp add: simps)
  next
    case (Ract ra) with assms show ?thesis by (cases ra) (auto simp add: simps)
  next
    case (Lact la) with assms show ?thesis by (cases la) (auto simp add: simps)
  next
    case (COMact ca) with assms show ?thesis by (cases ca) (auto simp add: simps)
  next
    case (Dact da) note a = this
      with assms show ?thesis proof (cases da)
        case (dFriend uid p uid') note ca = this
          then show ?thesis
          proof (cases "(uid = UID1 ∧ uid' = UID2) ∨ (uid = UID2 ∧ uid' = UID1)")
            case True
              then have "eqButUID s s'" and "eqButUID s1 s1'"
                using step step1 rs rs1 unfolding a ca
                by (auto intro!: Dact_dFriend_step_eqButUID)+
              with ss1 show "eqButUID s' s1'" by (auto intro: eqButUID_sym eqButUID_trans)
          next
            case False
              have fIDs: "eqButUIDf (friendIDs s) (friendIDs s1)" using ss1 by (auto simp: simps)
              then have uid_uid': "uid ∈∈ friendIDs s uid' ⟷ uid ∈∈ friendIDs s1 uid'"
                                  "uid' ∈∈ friendIDs s uid ⟷ uid' ∈∈ friendIDs s1 uid"
                using False by (auto intro!: eqButUIDf_not_UID')
              have dfIDs: "distinct (friendIDs s uid)" "distinct (friendIDs s uid')"
                          "distinct (friendIDs s1 uid)" "distinct (friendIDs s1 uid')"
                using reach_distinct_friends_reqs[OF rs] reach_distinct_friends_reqs[OF rs1] by auto
              have "uid = UID1 ⟹ eqButUIDl UID2 (remove1 uid' (friendIDs s UID1)) (remove1 uid' (friendIDs s1 UID1))"
               and "uid = UID2 ⟹ eqButUIDl UID1 (remove1 uid' (friendIDs s UID2)) (remove1 uid' (friendIDs s1 UID2))"
               and "uid' = UID1 ⟹ eqButUIDl UID2 (remove1 uid (friendIDs s UID1)) (remove1 uid (friendIDs s1 UID1))"
               and "uid' = UID2 ⟹ eqButUIDl UID1 (remove1 uid (friendIDs s UID2)) (remove1 uid (friendIDs s1 UID2))"
                using fIDs uid_uid' by - (intro eqButUIDl_remove1_cong; simp add: eqButUIDf_def)+
              then have 1: "eqButUIDf ((friendIDs s)(uid := remove1 uid' (friendIDs s uid),
                                                      uid' := remove1 uid (friendIDs s uid')))
                                       ((friendIDs s1)(uid := remove1 uid' (friendIDs s1 uid),
                                                       uid' := remove1 uid (friendIDs s1 uid')))"
                using fIDs by (intro eqButUIDf_cong) (auto simp add: eqButUIDf_def)
              have "e_deleteFriend s uid p uid'
                ⟷ e_deleteFriend s1 uid p uid'"
                using uid_uid' ss1 by (auto simp: simps d_defs)
              with 1 show ?thesis using assms dfIDs unfolding a ca
                by (auto simp: simps d_defs distinct_remove1_removeAll)
          qed
      qed
  qed
qed

lemma eqButUID_step_friendIDs_eq:
assumes ss1: "eqButUID s s1"
and rs: "reach s" and rs1: "reach s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and a: "a ≠ Cact (cFriend UID1 (pass s UID1) UID2) ∧ a ≠ Cact (cFriend UID2 (pass s UID2) UID1) ∧
        a ≠ Dact (dFriend UID1 (pass s UID1) UID2) ∧ a ≠ Dact (dFriend UID2 (pass s UID2) UID1)"
and "friendIDs s = friendIDs s1"
shows "friendIDs s' = friendIDs s1'"
using assms proof (cases a)
  case (Sact sa) then show ?thesis using assms by (cases sa) (auto simp: s_defs) next
  case (Uact ua) then show ?thesis using assms by (cases ua) (auto simp: u_defs) next
  case (COMact ca) then show ?thesis using assms by (cases ca) (auto simp: com_defs) next
  case (Dact da) then show ?thesis using assms proof (cases da)
    case (dFriend uid p uid')
      with Dact assms show ?thesis
        by (cases "(uid,uid') ∈ {(UID1,UID2), (UID2,UID1)}")
           (auto simp: d_defs eqButUID_stateSelectors eqButUIDf_not_UID')
    qed
next
  case (Cact ca) then show ?thesis using assms proof (cases ca)
    case (cFriend uid p uid')
      { assume "p = pass s uid"
        then have "uid' ∈∈ pendingFReqs s uid ⟷ uid' ∈∈ pendingFReqs s1 uid"
          using Cact cFriend ss1 a by (intro eqButUIDf_not_UID') (auto simp: eqButUID_stateSelectors)
      }
      with Cact cFriend assms show ?thesis
        by (auto simp: c_defs eqButUID_stateSelectors)
    qed (auto simp: c_defs)
qed auto

lemma createFriend_sym: "createFriend s uid p uid' = createFriend s uid' p' uid"
unfolding c_defs by (cases "uid = uid'") (auto simp: fun_upd2_comm fun_upd_twist)

lemma deleteFriend_sym: "deleteFriend s uid p uid' = deleteFriend s uid' p' uid"
unfolding d_defs by (cases "uid = uid'") (auto simp: fun_upd_twist)

lemma createFriendReq_createFriend_absorb:
assumes "e_createFriendReq s uid' p uid req"
shows "createFriend (createFriendReq s uid' p1 uid req) uid p2 uid' = createFriend s uid p3 uid'"
using assms unfolding c_defs by (auto simp: remove1_idem remove1_append fun_upd2_absorb)

lemma eqButUID_deleteFriend12_friendIDs_eq:
assumes ss1: "eqButUID s s1"
and rs: "reach s" and rs1: "reach s1"
shows "friendIDs (deleteFriend s UID1 p UID2) = friendIDs (deleteFriend s1 UID1 p' UID2)"
proof -
  have "distinct (friendIDs s UID1)" "distinct (friendIDs s UID2)"
       "distinct (friendIDs s1 UID1)" "distinct (friendIDs s1 UID2)"
    using rs rs1 by (auto intro: reach_distinct_friends_reqs)
  then show ?thesis
    using ss1 unfolding eqButUID_def eqButUIDf_def unfolding d_defs
    by (auto simp: distinct_remove1_removeAll)
qed

lemma eqButUID_createFriend12_friendIDs_eq:
assumes ss1: "eqButUID s s1"
and rs: "reach s" and rs1: "reach s1"
and f12: "¬friends12 s" "¬friends12 s1"
shows "friendIDs (createFriend s UID1 p UID2) = friendIDs (createFriend s1 UID1 p' UID2)"
proof -
  have f12': "UID1 ∉ set (friendIDs s UID2)" "UID2 ∉ set (friendIDs s UID1)"
             "UID1 ∉ set (friendIDs s1 UID2)" "UID2 ∉ set (friendIDs s1 UID1)"
    using f12 rs rs1 reach_friendIDs_symmetric unfolding friends12_def by auto
  have "friendIDs s = friendIDs s1"
  proof (intro ext)
    fix uid
    show "friendIDs s uid = friendIDs s1 uid"
      using ss1 f12' unfolding eqButUID_def eqButUIDf_def
      by (cases "uid = UID1 ∨ uid = UID2") (auto simp: remove1_idem)
  qed
  then show ?thesis by (auto simp: c_defs)
qed

end

end

Theory Friend_Openness

(* The ``openness'' of the access window for the friendship confidentiality properties *)
theory Friend_Openness
  imports "Friend_State_Indistinguishability"
begin

subsection ‹Dynamic declassification trigger›

context Friend
begin

text ‹The dynamic declassification trigger condition holds, i.e.~the access window to the
confidential information is open, as long as the two users have not been created yet (so there cannot
be friendship between them) or while one of them is a local friend of an observer.›

definition openByA :: "state ⇒ bool"
where "openByA s ≡ ¬ UID1 ∈∈ userIDs s ∨ ¬ UID2 ∈∈ userIDs s"

definition openByF :: "state ⇒ bool"
where "openByF s ≡ ∃uid ∈ UIDs. uid ∈∈ friendIDs s UID1 ∨ uid ∈∈ friendIDs s UID2"

definition "open" :: "state ⇒ bool"
where "open s ≡ openByA s ∨ openByF s"

lemmas open_defs = open_def openByA_def openByF_def


lemma step_openByA_cases:
assumes "step s a = (ou, s')"
and "openByA s ≠ openByA s'"
obtains (CloseA) uid p uid' p' where "a = Cact (cUser uid p uid' p')"
                                     "uid' = UID1 ∨ uid' = UID2" "ou = outOK" "p = pass s uid"
                                     "openByA s" "¬openByA s'"
using assms proof (cases a)
  case (Dact da) then show ?thesis using assms by (cases da) (auto simp: d_defs openByA_def) next
  case (Uact ua) then show ?thesis using assms by (cases ua) (auto simp: u_defs openByA_def) next
  case (COMact ca) then show ?thesis using assms by (cases ca) (auto simp: com_defs openByA_def) next
  case (Sact sa)
    then show ?thesis using assms UID1_UID2 by (cases sa) (auto simp: s_defs openByA_def) next
  case (Cact ca)
    then show ?thesis using assms UID1_UID2 proof (cases ca)
      case (cUser uid p uid' p')
        then show ?thesis using Cact assms by (intro that) (auto simp: c_defs openByA_def)
    qed (auto simp: c_defs openByA_def)
qed auto

lemma step_openByF_cases:
assumes "step s a = (ou, s')"
and "openByF s ≠ openByF s'"
obtains
  (OpenF) uid p uid' where "a = Cact (cFriend uid p uid')" "ou = outOK" "p = pass s uid"
                           "uid ∈ UIDs ∧ uid' ∈ {UID1,UID2} ∨ uid ∈ {UID1,UID2} ∧ uid' ∈ UIDs"
                           "openByF s'" "¬openByF s"
| (CloseF) uid p uid' where "a = Dact (dFriend uid p uid')" "ou = outOK" "p = pass s uid"
                            "uid ∈ UIDs ∧ uid' ∈ {UID1,UID2} ∨ uid ∈ {UID1,UID2} ∧ uid' ∈ UIDs"
                            "openByF s" "¬openByF s'"
using assms proof (cases a)
  case (Uact ua) then show ?thesis using assms by (cases ua) (auto simp: u_defs openByF_def) next
  case (COMact ca) then show ?thesis using assms by (cases ca) (auto simp: com_defs openByF_def) next
  case (Sact sa)
    then show ?thesis using assms UID1_UID2 by (cases sa) (auto simp: s_defs openByF_def)
next
  case (Cact ca)
    then show ?thesis using assms UID1_UID2 proof (cases ca)
      case (cFriend uid p uid')
        then show ?thesis using Cact assms by (intro OpenF) (auto simp: c_defs openByF_def)
    qed (auto simp: c_defs openByF_def)
next
  case (Dact da)
    then show ?thesis using assms proof (cases da)
      case (dFriend uid p uid')
        then show ?thesis using Dact assms by (intro CloseF) (auto simp: d_defs openByF_def)
    qed
qed auto


lemma step_open_cases:
assumes step: "step s a = (ou, s')"
and op: "open s ≠ open s'"
obtains
  (CloseA) uid p uid' p' where "a = Cact (cUser uid p uid' p')"
                               "uid' = UID1 ∨ uid' = UID2" "ou = outOK" "p = pass s uid"
                               "openByA s" "¬openByA s'" "¬openByF s" "¬openByF s'"
| (OpenF) uid p uid' where "a = Cact (cFriend uid p uid')" "ou = outOK" "p = pass s uid"
                           "uid ∈ UIDs ∧ uid' ∈ {UID1,UID2} ∨ uid ∈ {UID1,UID2} ∧ uid' ∈ UIDs"
                           "openByF s'" "¬openByF s" "¬openByA s" "¬openByA s'"
| (CloseF) uid p uid' where "a = Dact (dFriend uid p uid')" "ou = outOK" "p = pass s uid"
                            "uid ∈ UIDs ∧ uid' ∈ {UID1,UID2} ∨ uid ∈ {UID1,UID2} ∧ uid' ∈ UIDs"
                            "openByF s" "¬openByF s'" "¬openByA s" "¬openByA s'"
proof -
  from op have "openByF s ≠ openByF s' ∨ openByA s ≠ openByA s'"
    unfolding open_def by auto
  then show thesis proof
    assume "openByF s ≠ openByF s'"
    with step show thesis proof (cases rule: step_openByF_cases)
      case (OpenF uid p uid')
        then have "openByA s = openByA s'" using step
          by (cases "openByA s ≠ openByA s'", elim step_openByA_cases) auto
        then have "¬openByA s ∧ ¬openByA s'" using op unfolding open_def by auto
        with OpenF show thesis by (intro that(2)) auto
    next
      case (CloseF uid p uid')
        then have "openByA s = openByA s'" using step
          by (cases "openByA s ≠ openByA s'", elim step_openByA_cases) auto
        then have "¬openByA s ∧ ¬openByA s'" using op unfolding open_def by auto
        with CloseF show thesis by (intro that(3)) auto
    qed
  next
    assume "openByA s ≠ openByA s'"
    with step show thesis proof (cases rule: step_openByA_cases)
      case (CloseA uid p uid' p')
        then have "openByF s = openByF s'" using step
          by (cases "openByF s ≠ openByF s'", elim step_openByF_cases) auto
        then have "¬openByF s ∧ ¬openByF s'" using op unfolding open_def by auto
        with CloseA show thesis by (intro that(1)) auto
    qed
  qed
qed


lemma eqButUID_openByA_eq:
assumes "eqButUID s s1"
shows "openByA s = openByA s1"
using assms unfolding openByA_def eqButUID_def by auto

lemma eqButUID_openByF_eq:
assumes ss1: "eqButUID s s1"
shows "openByF s = openByF s1"
proof -
  from ss1 have fIDs: "eqButUIDf (friendIDs s) (friendIDs s1)" unfolding eqButUID_def by auto
  have "∀uid ∈ UIDs. uid ∈∈ friendIDs s UID1 ⟷ uid ∈∈ friendIDs s1 UID1"
    using UID1_UID2_UIDs UID1_UID2 by (intro ballI eqButUIDf_not_UID'[OF fIDs]; auto)
  moreover have "∀uid ∈ UIDs. uid ∈∈ friendIDs s UID2 ⟷ uid ∈∈ friendIDs s1 UID2"
    using UID1_UID2_UIDs UID1_UID2 by (intro ballI eqButUIDf_not_UID'[OF fIDs]; auto)
  ultimately show "openByF s = openByF s1" unfolding openByF_def by auto
qed

lemma eqButUID_open_eq: "eqButUID s s1 ⟹ open s = open s1"
using eqButUID_openByA_eq eqButUID_openByF_eq unfolding open_def by blast


(* major *) lemma eqButUID_step_γ_out:
assumes ss1: "eqButUID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
(*and sT: "reachNT s" and s1: "reachNT s1"*)
and γ: "γ (Trans s a ou s')"
and os: "open s ⟶ friendIDs s = friendIDs s1"
shows "ou = ou1"
proof -
  obtain uid sa com_act where uid_a: "(userOfA a = Some uid ∧ uid ∈ UIDs ∧ uid ≠ UID1 ∧ uid ≠ UID2)
                                  ∨ a = COMact com_act ∨ a = Sact sa"
    using γ UID1_UID2_UIDs by fastforce
  { fix uid
    assume "uid ∈∈ friendIDs s UID1 ∨ uid ∈∈ friendIDs s UID2" and "uid ∈ UIDs"
    with os have "friendIDs s = friendIDs s1" unfolding open_def openByF_def by auto
  } note fIDs = this
  { fix uid uid'
    assume uid: "uid ≠ UID1" "uid ≠ UID2"
    have "friendIDs s uid = friendIDs s1 uid" (is ?f_eq)
     and "pendingFReqs s uid = pendingFReqs s1 uid" (is ?pFR_eq)
     and "uid ∈∈ friendIDs s uid' ⟷ uid ∈∈ friendIDs s1 uid'" (is ?f_iff)
     and "uid ∈∈ pendingFReqs s uid' ⟷ uid ∈∈ pendingFReqs s1 uid'" (is ?pFR_iff)
     and "friendReq s uid uid' = friendReq s1 uid uid'" (is ?FR_eq)
     and "friendReq s uid' uid = friendReq s1 uid' uid" (is ?FR_eq')
    proof -
      show ?f_eq ?pFR_eq using uid ss1 UID1_UID2_UIDs unfolding eqButUID_def
        by (auto intro!: eqButUIDf_not_UID)
      show ?f_iff ?pFR_iff using uid ss1 UID1_UID2_UIDs unfolding eqButUID_def
        by (auto intro!: eqButUIDf_not_UID')
      from uid have "¬ (uid,uid') ∈ {(UID1,UID2), (UID2,UID1)}" by auto
      then show ?FR_eq ?FR_eq' using ss1 UID1_UID2_UIDs unfolding eqButUID_def
        by (auto intro!: eqButUID12_not_UID)
    qed
  } note simps = this eqButUID_stateSelectors r_defs s_defs c_defs com_defs l_defs u_defs d_defs
  note facts = ss1 step step1 uid_a
  show ?thesis
  proof (cases a)
    case (Ract ra) then show ?thesis using facts by (cases ra) (auto simp add: simps)
  next
    case (Sact sa) then show ?thesis using facts by (cases sa) (auto simp add: simps)
  next
    case (Cact ca) then show ?thesis using facts by (cases ca) (auto simp add: simps)
  next
    case (COMact ca) then show ?thesis using facts by (cases ca) (auto simp add: simps)
  next
    case (Lact la)
      then show ?thesis using facts proof (cases la)
        case (lFriends uid p uid')
          with γ have uid: "uid ∈ UIDs" using Lact by auto
          then have uid_uid': "uid ∈∈ friendIDs s uid' ⟷ uid ∈∈ friendIDs s1 uid'"
            using ss1 UID1_UID2_UIDs unfolding eqButUID_def by (intro eqButUIDf_not_UID') auto
          show ?thesis
          proof (cases "(uid' = UID1 ∨ uid' = UID2) ∧ uid ∈∈ friendIDs s uid'")
            case True
              with uid have "friendIDs s = friendIDs s1" by (intro fIDs) auto
              then show ?thesis using lFriends facts Lact by (auto simp: simps)
          next
            case False
              then show ?thesis using lFriends facts Lact simps(1) uid_uid' by (auto simp: simps)
          qed
      next
        case (lInnerPosts uid p)
          then have o: "⋀nid. owner s nid = owner s1 nid"
                and n: "⋀nid. post s nid = post s1 nid"
                and nids: "postIDs s = postIDs s1"
                and vis: "vis s = vis s1"
                and fu: "⋀uid'. uid ∈∈ friendIDs s uid' ⟷ uid ∈∈ friendIDs s1 uid'"
                and e: "e_listInnerPosts s uid p ⟷ e_listInnerPosts s1 uid p"
            using ss1 uid_a Lact unfolding eqButUID_def l_defs by (auto simp add: simps(3))
          have "listInnerPosts s uid p = listInnerPosts s1 uid p"
            unfolding listInnerPosts_def o n nids vis fu ..
          with e show ?thesis using Lact lInnerPosts step step1 by auto
      qed (auto simp add: simps)
  next
    case (Uact ua) then show ?thesis using facts by (cases ua) (auto simp add: simps)
  next
    case (Dact da) then show ?thesis using facts by (cases da) (auto simp add: simps)
  qed
qed

end

end

Theory Friend_Value_Setup

(* The value setup for friendship status confidentiality *)
theory Friend_Value_Setup
  imports "Friend_Openness"
begin

subsection ‹Value Setup›

context Friend
begin

datatype "value" =
  FrVal bool ― ‹updated friendship status between ‹UID1› and ‹UID2››
| OVal bool ― ‹updated dynamic declassification trigger condition›

fun φ :: "(state,act,out) trans ⇒ bool" where
"φ (Trans s (Cact (cFriend uid p uid')) ou s') =
  ((uid,uid') ∈ {(UID1,UID2), (UID2,UID1)} ∧ ou = outOK ∨
   open s ≠ open s')"
|
"φ (Trans s (Dact (dFriend uid p uid')) ou s') =
  ((uid,uid') ∈ {(UID1,UID2), (UID2,UID1)} ∧ ou = outOK ∨
   open s ≠ open s')"
|
"φ (Trans s (Cact (cUser uid p uid' p')) ou s') =
  (open s ≠ open s')"
|
"φ _ = False"

fun f :: "(state,act,out) trans ⇒ value" where
"f (Trans s (Cact (cFriend uid p uid')) ou s') =
  (if (uid,uid') ∈ {(UID1,UID2), (UID2,UID1)} then FrVal True
                                              else OVal True)"
|
"f (Trans s (Dact (dFriend uid p uid')) ou s') =
  (if (uid,uid') ∈ {(UID1,UID2), (UID2,UID1)} then FrVal False
                                              else OVal False)"
|
"f (Trans s (Cact (cUser uid p uid' p')) ou s') = OVal False"
|
"f _ = undefined"


lemma φE:
assumes φ: "φ (Trans s a ou s')" (is "φ ?trn")
and step: "step s a = (ou, s')"
and rs: "reach s"
obtains (Friend) uid p uid' where "a = Cact (cFriend uid p uid')" "ou = outOK" "f ?trn = FrVal True"
                                  "uid = UID1 ∧ uid' = UID2 ∨ uid = UID2 ∧ uid' = UID1"
                                  "IDsOK s [UID1, UID2] [] [] []"
                                  "¬friends12 s" "friends12 s'"
      | (Unfriend) uid p uid' where "a = Dact (dFriend uid p uid')" "ou = outOK" "f ?trn = FrVal False"
                                    "uid = UID1 ∧ uid' = UID2 ∨ uid = UID2 ∧ uid' = UID1"
                                    "IDsOK s [UID1, UID2] [] [] []"
                                    "friends12 s" "¬friends12 s'"
      | (OpenF) uid p uid' where "a = Cact (cFriend uid p uid')"
                                 "(uid ∈ UIDs ∧ uid' ∈ {UID1,UID2}) ∨ (uid' ∈ UIDs ∧ uid ∈ {UID1,UID2})"
                                 "ou = outOK" "f ?trn = OVal True" "¬openByF s" "openByF s'"
                                 "¬openByA s" "¬openByA s'"
      | (CloseF) uid p uid' where "a = Dact (dFriend uid p uid')"
                                  "(uid ∈ UIDs ∧ uid' ∈ {UID1,UID2}) ∨ (uid' ∈ UIDs ∧ uid ∈ {UID1,UID2})"
                                  "ou = outOK" "f ?trn = OVal False" "openByF s" "¬openByF s'"
                                  "¬openByA s" "¬openByA s'"
      | (CloseA) uid p uid' p' where "a = Cact (cUser uid p uid' p')"
                                     "uid' ∈ {UID1,UID2}" "openByA s" "¬openByA s'"
                                     "¬openByF s" "¬openByF s'"
                                     "ou = outOK" "f ?trn = OVal False"
using φ proof (elim φ.elims disjE conjE)
  fix s1 uid p uid' ou1 s1'
  assume "(uid,uid') ∈ {(UID1,UID2), (UID2,UID1)}" and ou: "ou1 = outOK"
     and "?trn = Trans s1 (Cact (cFriend uid p uid')) ou1 s1'"
  then have trn: "a = Cact (cFriend uid p uid')" "s = s1" "s' = s1'" "ou = ou1"
        and uids: "uid = UID1 ∧ uid' = UID2 ∨ uid = UID2 ∧ uid' = UID1" using UID1_UID2 by auto
  then show thesis using ou uids trn step UID1_UID2_UIDs UID1_UID2 reach_distinct_friends_reqs[OF rs]
    by (intro Friend[of uid p uid']) (auto simp add: c_defs friends12_def)
next
  fix s1 uid p uid' ou1 s1'
  assume op: "open s1 ≠ open s1'"
     and "?trn = Trans s1 (Cact (cFriend uid p uid')) ou1 s1'"
  then have trn: "open s ≠ open s'" "s = s1" "s' = s1'" "ou = ou1"
        and a: "a = Cact (cFriend uid p uid')"
    by auto
  with step have uids: "(uid ∈ UIDs ∧ uid' ∈ {UID1, UID2} ∨ uid ∈ {UID1, UID2} ∧ uid' ∈ UIDs) ∧
                        ou = outOK ∧ ¬openByF s ∧ openByF s' ∧ ¬openByA s ∧ ¬openByA s'"
    by (cases rule: step_open_cases) auto
  then show thesis using a UID1_UID2_UIDs by (intro OpenF) auto
next
  fix s1 uid p uid' ou1 s1'
  assume "(uid,uid') ∈ {(UID1,UID2), (UID2,UID1)}" and ou: "ou1 = outOK"
     and "?trn = Trans s1 (Dact (dFriend uid p uid')) ou1 s1'"
  then have trn: "a = Dact (dFriend uid p uid')" "s = s1" "s' = s1'" "ou = ou1"
        and uids: "uid = UID1 ∧ uid' = UID2 ∨ uid = UID2 ∧ uid' = UID1" using UID1_UID2 by auto
  then show thesis using step ou reach_friendIDs_symmetric[OF rs]
    by (intro Unfriend) (auto simp: d_defs friends12_def)
next
  fix s1 uid p uid' ou1 s1'
  assume op: "open s1 ≠ open s1'"
     and "?trn = Trans s1 (Dact (dFriend uid p uid')) ou1 s1'"
  then have trn: "open s ≠ open s'" "s = s1" "s' = s1'" "ou = ou1"
        and a: "a = Dact (dFriend uid p uid')"
    by auto
  with step have uids: "(uid ∈ UIDs ∧ uid' ∈ {UID1, UID2} ∨ uid ∈ {UID1, UID2} ∧ uid' ∈ UIDs) ∧
                        ou = outOK ∧ openByF s ∧ (¬openByF s') ∧ (¬openByA s) ∧ (¬openByA s')"
    by (cases rule: step_open_cases) auto
  then show thesis using a UID1_UID2_UIDs by (intro CloseF) auto
next
  fix s1 uid p uid' p' ou1 s1'
  assume op: "open s1 ≠ open s1'"
     and "?trn = Trans s1 (Cact (cUser uid p uid' p')) ou1 s1'"
  then have trn: "open s ≠ open s'" "s = s1" "s' = s1'" "ou = ou1"
        and a: "a = Cact (cUser uid p uid' p')"
    by auto
  with step have uids: "(uid' = UID2 ∨ uid' = UID1) ∧ ou = outOK ∧
                        (¬openByF s) ∧ (¬openByF s') ∧ openByA s ∧ (¬openByA s')"
    by (cases rule: step_open_cases) auto
  then show thesis using a UID1_UID2_UIDs by (intro CloseA) auto
qed

lemma step_open_φ:
assumes "step s a = (ou, s')"
and "open s ≠ open s'"
shows "φ (Trans s a ou s')"
using assms by (cases rule: step_open_cases) (auto simp: open_def)

lemma step_friends12_φ:
assumes "step s a = (ou, s')"
and "friends12 s ≠ friends12 s'"
shows "φ (Trans s a ou s')"
proof -
  have "a = Cact (cFriend UID1 (pass s UID1) UID2) ∨ a = Cact (cFriend UID2 (pass s UID2) UID1) ∨
        a = Dact (dFriend UID1 (pass s UID1) UID2) ∨ a = Dact (dFriend UID2 (pass s UID2) UID1)"
   using assms step_friends12 by (cases "ou = outOK") auto
  moreover then have "ou = outOK" using assms by auto
  ultimately show "φ (Trans s a ou s')" by auto
qed

lemma eqButUID_step_φ_imp:
assumes ss1: "eqButUID s s1"
and rs: "reach s" and rs1: "reach s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and a: "a ≠ Cact (cFriend UID1 (pass s UID1) UID2) ∧ a ≠ Cact (cFriend UID2 (pass s UID2) UID1) ∧
        a ≠ Dact (dFriend UID1 (pass s UID1) UID2) ∧ a ≠ Dact (dFriend UID2 (pass s UID2) UID1)"
and φ: "φ (Trans s a ou s')"
shows "φ (Trans s1 a ou1 s1')"
proof -
  have "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
  then have "open s = open s1" and "open s' = open s1'"
        and "openByA s = openByA s1" and "openByA s' = openByA s1'"
        and "openByF s = openByF s1" and "openByF s' = openByF s1'"
    using ss1 by (auto simp: eqButUID_open_eq eqButUID_openByA_eq eqButUID_openByF_eq)
  with φ a step step1 show "φ (Trans s1 a ou1 s1')" using UID1_UID2_UIDs
    by (elim φ.elims) (auto simp: c_defs d_defs)
qed

lemma eqButUID_step_φ:
assumes ss1: "eqButUID s s1"
and rs: "reach s" and rs1: "reach s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and a: "a ≠ Cact (cFriend UID1 (pass s UID1) UID2) ∧ a ≠ Cact (cFriend UID2 (pass s UID2) UID1) ∧
        a ≠ Dact (dFriend UID1 (pass s UID1) UID2) ∧ a ≠ Dact (dFriend UID2 (pass s UID2) UID1)"
shows "φ (Trans s a ou s') = φ (Trans s1 a ou1 s1')"
proof
  assume "φ (Trans s a ou s')"
  with assms show "φ (Trans s1 a ou1 s1')" by (rule eqButUID_step_φ_imp)
next
  assume "φ (Trans s1 a ou1 s1')"
  moreover have "eqButUID s1 s" using ss1 by (rule eqButUID_sym)
  moreover have "a ≠ Cact (cFriend UID1 (pass s1 UID1) UID2) ∧
                 a ≠ Cact (cFriend UID2 (pass s1 UID2) UID1) ∧
                 a ≠ Dact (dFriend UID1 (pass s1 UID1) UID2) ∧
                 a ≠ Dact (dFriend UID2 (pass s1 UID2) UID1)"
    using a ss1 by (auto simp: eqButUID_stateSelectors)
  ultimately show "φ (Trans s a ou s')" using rs rs1 step step1
    by (intro eqButUID_step_φ_imp[of s1 s])
qed

end

end
iv class="head">

Theory Friend

theory Friend
  imports
    "Friend_Value_Setup"
    "Bounded_Deducibility_Security.Compositional_Reasoning"
begin

subsection ‹Declassification bound›


context Friend
begin

fun T :: "(state,act,out) trans ⇒ bool"
where "T trn = False"

text ‹The bound has the same ``while-or-last-before'' shape as the dynamic version of
the issuer bound for post confidentiality (Section~\ref{sec:dynamic-post-issuer}),
alternating between phases with open (‹BO›) or closed (‹BC›) access to the
confidential information.

The access window is initially open, because the two users are known not to exist when the system
is initialized, so there cannot be friendship between them.

The bound also incorporates the static knowledge that the friendship status alternates between
‹False› and ‹True›.›

fun alternatingFriends :: "value list ⇒ bool ⇒ bool" where
  "alternatingFriends [] _ = True"
| "alternatingFriends (FrVal st # vl) st' ⟷ st' = (¬st) ∧ alternatingFriends vl st"
| "alternatingFriends (OVal _ # vl) st = alternatingFriends vl st"

inductive BO :: "value list ⇒ value list ⇒ bool"
and BC :: "value list ⇒ value list ⇒ bool"
where
 BO_FrVal[simp,intro!]:
  "BO (map FrVal fs) (map FrVal fs)"
|BO_BC[intro]:
  "BC vl vl1 ⟹
   BO (map FrVal fs @ OVal False # vl) (map FrVal fs @ OVal False # vl1)"
(*  *)
|BC_FrVal[simp,intro!]:
  "BC (map FrVal fs) (map FrVal fs1)"
|BC_BO[intro]:
  "BO vl vl1 ⟹ (fs = [] ⟷ fs1 = []) ⟹ (fs ≠ [] ⟹ last fs = last fs1) ⟹
   BC (map FrVal fs  @ OVal True # vl)
      (map FrVal fs1 @ OVal True # vl1)"

definition "B vl vl1 ≡ BO vl vl1 ∧ alternatingFriends vl1 False"


lemma BO_Nil_Nil: "BO vl vl1 ⟹ vl = [] ⟹ vl1 = []"
by (cases rule: BO.cases) auto

no_notation relcomp (infixr "O" 75)

sublocale BD_Security_IO where
istate = istate and step = step and
φ = φ and f = f and γ = γ and g = g and T = T and B = B
done


subsection ‹Unwinding proof›

(* helper *) lemma toggle_friends12_True:
assumes rs: "reach s"
    and IDs: "IDsOK s [UID1, UID2] [] [] []"
    and nf12: "¬friends12 s"
obtains al oul
where "sstep s al = (oul, createFriend s UID1 (pass s UID1) UID2)"
  and "al ≠ []" and "eqButUID s (createFriend s UID1 (pass s UID1) UID2)"
  and "friends12 (createFriend s UID1 (pass s UID1) UID2)"
  and "O (traceOf s al) = []" and "V (traceOf s al) = [FrVal True]"
proof cases
  assume "UID1 ∈∈ pendingFReqs s UID2 ∨ UID2 ∈∈ pendingFReqs s UID1"
  then show thesis proof
    assume pFR: "UID1 ∈∈ pendingFReqs s UID2"
    let ?a = "Cact (cFriend UID2 (pass s UID2) UID1)"
    let ?s' = "createFriend s UID1 (pass s UID1) UID2"
    let ?trn = "Trans s ?a outOK ?s'"
    have step: "step s ?a = (outOK, ?s')" using IDs pFR UID1_UID2
      unfolding createFriend_sym[of "s" "UID1" "pass s UID1" "UID2" "pass s UID2"]
      by (auto simp add: c_defs)
    moreover then have "φ ?trn" and "f ?trn = FrVal True" and "friends12 ?s'"
      by (auto simp: c_defs friends12_def)
    moreover have "¬γ ?trn" using UID1_UID2_UIDs by auto
    ultimately show thesis using nf12 rs
      by (intro that[of "[?a]" "[outOK]"]) (auto intro: Cact_cFriend_step_eqButUID)
  next
    assume pFR: "UID2 ∈∈ pendingFReqs s UID1"
    let ?a = "Cact (cFriend UID1 (pass s UID1) UID2)"
    let ?s' = "createFriend s UID1 (pass s UID1) UID2"
    let ?trn = "Trans s ?a outOK ?s'"
    have step: "step s ?a = (outOK, ?s')" using IDs pFR UID1_UID2 by (auto simp add: c_defs)
    moreover then have "φ ?trn" and "f ?trn = FrVal True" and "friends12 ?s'"
      by (auto simp: c_defs friends12_def)
    moreover have "¬γ ?trn" using UID1_UID2_UIDs by auto
    ultimately show thesis using nf12 rs
      by (intro that[of "[?a]" "[outOK]"]) (auto intro: Cact_cFriend_step_eqButUID)
  qed
next
  assume pFR: "¬(UID1 ∈∈ pendingFReqs s UID2 ∨ UID2 ∈∈ pendingFReqs s UID1)"
  let ?a1 = "Cact (cFriendReq UID2 (pass s UID2) UID1 emptyRequestInfo)"
  let ?s1 = "createFriendReq s UID2 (pass s UID2) UID1 emptyRequestInfo"
  let ?trn1 = "Trans s ?a1 outOK ?s1"
  let ?a2 = "Cact (cFriend UID1 (pass ?s1 UID1) UID2)"
  let ?s2 = "createFriend ?s1 UID1 (pass ?s1 UID1) UID2"
  let ?trn2 = "Trans ?s1 ?a2 outOK ?s2"
  have eFR: "e_createFriendReq s UID2 (pass s UID2) UID1 emptyRequestInfo" using IDs pFR nf12
    using reach_friendIDs_symmetric[OF rs]
    by (auto simp add: c_defs friends12_def)
  then have step1: "step s ?a1 = (outOK, ?s1)" by auto
  moreover then have "¬φ ?trn1" and "¬γ ?trn1" using UID1_UID2_UIDs by auto
  moreover have "eqButUID s ?s1" by (intro Cact_cFriendReq_step_eqButUID[OF step1]) auto
  moreover have rs1: "reach ?s1" using step1 by (intro reach_PairI[OF rs])
  moreover have step2: "step ?s1 ?a2 = (outOK, ?s2)" using IDs by (auto simp: c_defs)
  moreover then have "φ ?trn2" and "f ?trn2 = FrVal True" and "friends12 ?s2"
    by (auto simp: c_defs friends12_def)
  moreover have "¬γ ?trn2" using UID1_UID2_UIDs by auto
  moreover have "eqButUID ?s1 ?s2" by (intro Cact_cFriend_step_eqButUID[OF step2 rs1]) auto
  moreover have "?s2 = createFriend s UID1 (pass s UID1) UID2"
    using eFR by (intro createFriendReq_createFriend_absorb)
  ultimately show thesis using nf12 rs
    by (intro that[of "[?a1, ?a2]" "[outOK, outOK]"]) (auto intro: eqButUID_trans)
qed

(* helper *) lemma toggle_friends12_False:
assumes rs: "reach s"
    and IDs: "IDsOK s [UID1, UID2] [] [] []"
    and f12: "friends12 s"
obtains al oul
where "sstep s al = (oul, deleteFriend s UID1 (pass s UID1) UID2)"
  and "al ≠ []" and "eqButUID s (deleteFriend s UID1 (pass s UID1) UID2)"
  and "¬friends12 (deleteFriend s UID1 (pass s UID1) UID2)"
  and "O (traceOf s al) = []" and "V (traceOf s al) = [FrVal False]"
proof -
  let ?a = "Dact (dFriend UID1 (pass s UID1) UID2)"
  let ?s' = "deleteFriend s UID1 (pass s UID1) UID2"
  let ?trn = "Trans s ?a outOK ?s'"
  have step: "step s ?a = (outOK, ?s')" using IDs f12 UID1_UID2
    by (auto simp add: d_defs friends12_def)
  moreover then have "φ ?trn" and "f ?trn = FrVal False" and "¬friends12 ?s'"
    using reach_friendIDs_symmetric[OF rs] by (auto simp: d_defs friends12_def)
  moreover have "¬γ ?trn" using UID1_UID2_UIDs by auto
  ultimately show thesis using f12 rs
    by (intro that[of "[?a]" "[outOK]"]) (auto intro: Dact_dFriend_step_eqButUID)
qed


definition Δ0 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ0 s vl s1 vl1 ≡
 eqButUID s s1 ∧ friendIDs s = friendIDs s1 ∧ open s ∧
 BO vl vl1 ∧ alternatingFriends vl1 (friends12 s1)"

definition Δ1 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ1 s vl s1 vl1 ≡ (∃fs fs1.
 eqButUID s s1 ∧ ¬open s ∧
 alternatingFriends vl1 (friends12 s1) ∧
 vl = map FrVal fs ∧ vl1 = map FrVal fs1)"

definition Δ2 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ2 s vl s1 vl1 ≡ (∃fs fs1 vlr vlr1.
 eqButUID s s1 ∧ ¬open s ∧ BO vlr vlr1 ∧
 alternatingFriends vl1 (friends12 s1) ∧
 (fs = [] ⟷ fs1 = []) ∧
 (fs ≠ [] ⟶ last fs = last fs1) ∧
 (fs = [] ⟶ friendIDs s = friendIDs s1) ∧
 vl =  map FrVal fs  @ OVal True # vlr ∧
 vl1 = map FrVal fs1 @ OVal True # vlr1)"

lemma Δ2_I:
assumes "eqButUID s s1" "¬open s" "BO vlr vlr1" "alternatingFriends vl1 (friends12 s1)"
        "fs = [] ⟷ fs1 = []" "fs ≠ [] ⟶ last fs = last fs1"
        "fs = [] ⟶ friendIDs s = friendIDs s1"
        "vl =  map FrVal fs  @ OVal True # vlr"
        "vl1 = map FrVal fs1 @ OVal True # vlr1"
shows "Δ2 s vl s1 vl1"
using assms unfolding Δ2_def by blast


lemma istate_Δ0:
assumes B: "B vl vl1"
shows "Δ0 istate vl istate vl1"
using assms unfolding Δ0_def istate_def B_def open_def openByA_def openByF_def friends12_def
by auto

lemma unwind_cont_Δ0: "unwind_cont Δ0 {Δ0,Δ1,Δ2}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ0 s vl s1 vl1 ∨
                           Δ1 s vl s1 vl1 ∨
                           Δ2 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Δ0: "Δ0 s vl s1 vl1"
  then have rs: "reach s" and ss1: "eqButUID s s1" and fIDs: "friendIDs s = friendIDs s1"
        and os: "open s" and BO: "BO vl vl1" and aF1: "alternatingFriends vl1 (friends12 s1)"
    using reachNT_reach unfolding Δ0_def by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof cases
        assume φ: "φ ?trn"
        then have vl: "vl = f ?trn # vl'" using c by (auto simp: consume_def)
        from BO have ?match proof (cases "f ?trn")
          case (FrVal fv)
            with BO vl obtain vl1' where vl1': "vl1 = f ?trn # vl1'" and BO': "BO vl' vl1'"
            proof (cases rule: BO.cases)
              case (BO_BC vl'' vl1'' fs)
                moreover with vl FrVal obtain fs' where "fs = fv # fs'" by (cases fs) auto
                ultimately show ?thesis using FrVal BO_BC vl
                  by (intro that[of "map FrVal fs' @ OVal False # vl1''"]) auto
            qed auto
            from fIDs have f12: "friends12 s = friends12 s1" unfolding friends12_def by auto
            show ?match using φ step rs FrVal proof (cases rule: φE)
              case (Friend uid p uid')
                then have IDs1: "IDsOK s1 [UID1, UID2] [] [] []"
                  using ss1 unfolding eqButUID_def by auto
                let ?s1' = "createFriend s1 UID1 (pass s1 UID1) UID2"
                have s': "s' = createFriend s UID1 p UID2"
                  using Friend step by (auto simp: createFriend_sym)
                have ss': "eqButUID s s'" using rs step Friend
                  by (auto intro: Cact_cFriend_step_eqButUID)
                moreover then have os': "open s'" using os eqButUID_open_eq by auto
                moreover obtain al oul where al: "sstep s1 al = (oul, ?s1')" "al ≠ []"
                                         and tr1: "O (traceOf s1 al) = []"
                                                  "V (traceOf s1 al) = [FrVal True]"
                                         and f12s1': "friends12 ?s1'"
                                         and s1s1': "eqButUID s1 ?s1'"
                  using rs1 IDs1 Friend unfolding f12 by (auto elim: toggle_friends12_True)
                moreover have "friendIDs s' = friendIDs ?s1'"
                  using Friend(6) f12 unfolding s'
                  by (intro eqButUID_createFriend12_friendIDs_eq[OF ss1 rs rs1]) auto
                ultimately have "Δ0 s' vl' ?s1' vl1'"
                  using ss1 BO' aF1 unfolding Δ0_def vl1' Friend(3)
                  by (auto intro: eqButUID_trans eqButUID_sym)
                then show ?match using tr1 vl1' Friend UID1_UID2_UIDs
                  by (intro matchI_ms[OF al]) (auto simp: consumeList_def)
            next
              case (Unfriend uid p uid')
                then have IDs1: "IDsOK s1 [UID1, UID2] [] [] []"
                  using ss1 unfolding eqButUID_def by auto
                let ?s1' = "deleteFriend s1 UID1 (pass s1 UID1) UID2"
                have s': "s' = deleteFriend s UID1 p UID2"
                  using Unfriend step by (auto simp: deleteFriend_sym)
                have ss': "eqButUID s s'" using rs step Unfriend
                  by (auto intro: Dact_dFriend_step_eqButUID)
                moreover then have os': "open s'" using os eqButUID_open_eq by auto
                moreover obtain al oul where al: "sstep s1 al = (oul, ?s1')" "al ≠ []"
                                         and tr1: "O (traceOf s1 al) = []"
                                                  "V (traceOf s1 al) = [FrVal False]"
                                         and f12s1': "¬friends12 ?s1'"
                                         and s1s1': "eqButUID s1 ?s1'"
                  using rs1 IDs1 Unfriend unfolding f12 by (auto elim: toggle_friends12_False)
                moreover have "friendIDs s' = friendIDs ?s1'"
                  using fIDs unfolding s' by (auto simp: d_defs)
                ultimately have "Δ0 s' vl' ?s1' vl1'"
                  using ss1 BO' aF1 unfolding Δ0_def vl1' Unfriend(3)
                  by (auto intro: eqButUID_trans eqButUID_sym)
                then show ?match using tr1 vl1' Unfriend UID1_UID2_UIDs
                  by (intro matchI_ms[OF al]) (auto simp: consumeList_def)
            qed auto
        next
          case (OVal ov)
            with BO vl obtain vl1' where vl1': "vl1 = OVal False # vl1'"
                                      and vl': "vl = OVal False # vl'"
                                      and BC: "BC vl' vl1'"
            proof (cases rule: BO.cases)
              case (BO_BC vl'' vl1'' fs)
                moreover then have "fs = []" using vl unfolding OVal by (cases fs) auto
                ultimately show thesis using vl by (intro that[of vl1'']) auto
            qed auto
            then have "f ?trn = OVal False" using vl by auto
            with φ step rs show ?match proof (cases rule: φE)
              case (CloseF uid p uid')
                let ?s1' = "deleteFriend s1 uid p uid'"
                let ?trn1 = "Trans s1 a outOK ?s1'"
                have s': "s' = deleteFriend s uid p uid'" using CloseF step by auto
                have step1: "step s1 a = (outOK, ?s1')"
                  using CloseF step ss1 fIDs unfolding eqButUID_def by (auto simp: d_defs)
                have s's1': "eqButUID s' ?s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
                moreover have os': "¬open s'" using CloseF os unfolding open_def by auto
                moreover have fIDs': "friendIDs s' = friendIDs ?s1'"
                  using fIDs unfolding s' by (auto simp: d_defs)
                moreover have f12s1: "friends12 s1 = friends12 ?s1'"
                  using CloseF(2) UID1_UID2_UIDs unfolding friends12_def d_defs by auto
                from BC have "Δ1 s' vl' ?s1' vl1' ∨ Δ2 s' vl' ?s1' vl1'"
                proof (cases rule: BC.cases)
                  case (BC_FrVal fs fs1)
                    then show ?thesis using aF1 os' fIDs' f12s1 s's1' unfolding Δ1_def vl1' by auto
                next
                  case (BC_BO vlr vlr1 fs fs1)
                    then have "Δ2 s' vl' ?s1' vl1'" using s's1' os' aF1 f12s1 fIDs' unfolding vl1'
                      by (intro Δ2_I[of _ _ _ _ _ fs fs1]) auto
                    then show ?thesis ..
                qed
                moreover have "open s1" "¬open ?s1'"
                  using ss1 os s's1' os' by (auto simp: eqButUID_open_eq)
                moreover then have "φ ?trn1" unfolding CloseF by auto
                ultimately show ?match using step1 vl1' CloseF UID1_UID2 UID1_UID2_UIDs
                  by (intro matchI[of s1 a outOK ?s1' vl1 vl1']) (auto simp: consume_def)
            next
              case (CloseA uid p uid' p')
                let ?s1' = "createUser s1 uid p uid' p'"
                let ?trn1 = "Trans s1 a outOK ?s1'"
                have s': "s' = createUser s uid p uid' p'" using CloseA step by auto
                have step1: "step s1 a = (outOK, ?s1')"
                  using CloseA step ss1 unfolding eqButUID_def by (auto simp: c_defs)
                have s's1': "eqButUID s' ?s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
                moreover have os': "¬open s'" using CloseA os unfolding open_def by auto
                moreover have fIDs': "friendIDs s' = friendIDs ?s1'"
                  using fIDs unfolding s' by (auto simp: c_defs)
                moreover have f12s1: "friends12 s1 = friends12 ?s1'"
                  unfolding friends12_def by (auto simp: c_defs)
                from BC have "Δ1 s' vl' ?s1' vl1' ∨ Δ2 s' vl' ?s1' vl1'"
                proof (cases rule: BC.cases)
                  case (BC_FrVal fs fs1)
                    then show ?thesis using aF1 os' fIDs' f12s1 s's1' unfolding Δ1_def vl1' by auto
                next
                  case (BC_BO vlr vlr1 fs fs1)
                    then have "Δ2 s' vl' ?s1' vl1'" using s's1' os' aF1 f12s1 fIDs' unfolding vl1'
                      by (intro Δ2_I[of _ _ _ _ _ fs fs1]) auto
                    then show ?thesis ..
                qed
                moreover have "open s1" "¬open ?s1'"
                  using ss1 os s's1' os' by (auto simp: eqButUID_open_eq)
                moreover then have "φ ?trn1" unfolding CloseA by auto
                ultimately show ?match using step1 vl1' CloseA UID1_UID2 UID1_UID2_UIDs
                  by (intro matchI[of s1 a outOK ?s1' vl1 vl1']) (auto simp: consume_def)
            qed auto
        qed
        then show "?match ∨ ?ignore" ..
      next
        assume nφ: "¬φ ?trn"
        then have os': "open s = open s'" and f12s': "friends12 s = friends12 s'"
          using step_open_φ[OF step] step_friends12_φ[OF step] by auto
        have vl': "vl' = vl" using nφ c by (auto simp: consume_def)
        show ?thesis proof (cases "a ≠ Cact (cFriend UID1 (pass s UID1) UID2) ∧
                                   a ≠ Cact (cFriend UID2 (pass s UID2) UID1) ∧
                                   a ≠ Dact (dFriend UID1 (pass s UID1) UID2) ∧
                                   a ≠ Dact (dFriend UID2 (pass s UID2) UID1)")
          case True
            obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by (cases "step s1 a") auto
            let ?trn1 = "Trans s1 a ou1 s1'"
            have fIDs': "friendIDs s' = friendIDs s1'"
              using eqButUID_step_friendIDs_eq[OF ss1 rs rs1 step step1 True fIDs] .
            from True nφ have nφ': "¬φ ?trn1" using eqButUID_step_φ[OF ss1 rs rs1 step step1] by auto
            then have f12s1': "friends12 s1 = friends12 s1'"
              using step_friends12_φ[OF step1] by auto
            have "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
            then have "Δ0 s' vl' s1' vl1" using os fIDs' aF1 BO
              unfolding Δ0_def os' f12s1' vl' by auto
            then have ?match
              using step1 nφ' fIDs eqButUID_step_γ_out[OF ss1 step step1]
              by (intro matchI[of s1 a ou1 s1' vl1 vl1]) (auto simp: consume_def)
            then show "?match ∨ ?ignore" ..
        next
          case False
            with nφ have "ou ≠ outOK" by auto
            then have "s' = s" using step False by auto
            then have ?ignore using Δ0 False UID1_UID2_UIDs unfolding vl' by (intro ignoreI) auto
            then show "?match ∨ ?ignore" ..
        qed
      qed
    qed
    then show ?thesis using BO BO_Nil_Nil by auto
  qed
qed

lemma unwind_cont_Δ1: "unwind_cont Δ1 {Δ1, Δ0}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ1 s vl s1 vl1 ∨ Δ0 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and 1: "Δ1 s vl s1 vl1"
  from rsT have rs: "reach s" by (intro reachNT_reach)
  from 1 obtain fs fs1
  where ss1: "eqButUID s s1" and os: "¬open s"
    and aF1: "alternatingFriends vl1 (friends12 s1)"
    and vl: "vl = map FrVal fs" and vl1: "vl1 = map FrVal fs1"
    unfolding Δ1_def by auto
  from os have IDs: "IDsOK s [UID1, UID2] [] [] []" unfolding open_defs by auto
  then have IDs1: "IDsOK s1 [UID1, UID2] [] [] []" using ss1 unfolding eqButUID_def by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof cases
    assume fs1: "fs1 = []"
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof cases
        assume φ: "φ ?trn"
        with vl c obtain fv fs' where vl': "vl' = map FrVal fs'" and fv: "f ?trn = FrVal fv"
          by (cases fs) (auto simp: consume_def)
        from φ step rs fv have ss': "eqButUID s s'"
          by (elim φE) (auto intro: Cact_cFriend_step_eqButUID Dact_dFriend_step_eqButUID)
        then have "¬open s'" using os by (auto simp: eqButUID_open_eq)
        moreover have "eqButUID s' s1" using ss1 ss' by (auto intro: eqButUID_sym eqButUID_trans)
        ultimately have "Δ1 s' vl' s1 vl1" using aF1 unfolding Δ1_def vl' vl1 by auto
        moreover have "¬γ ?trn" using φ step rs fv UID1_UID2_UIDs by (elim φE) auto
        ultimately have ?ignore by (intro ignoreI) auto
        then show "?match ∨ ?ignore" ..
      next
        assume nφ: "¬φ ?trn"
        then have os': "open s = open s'" and f12s': "friends12 s = friends12 s'"
          using step_open_φ[OF step] step_friends12_φ[OF step] by auto
        have vl': "vl' = vl" using nφ c by (auto simp: consume_def)
        show ?thesis proof (cases "a ≠ Cact (cFriend UID1 (pass s UID1) UID2) ∧
                                   a ≠ Cact (cFriend UID2 (pass s UID2) UID1) ∧
                                   a ≠ Dact (dFriend UID1 (pass s UID1) UID2) ∧
                                   a ≠ Dact (dFriend UID2 (pass s UID2) UID1)")
          case True
            obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by (cases "step s1 a") auto
            let ?trn1 = "Trans s1 a ou1 s1'"
            from True nφ have nφ': "¬φ ?trn1" using eqButUID_step_φ[OF ss1 rs rs1 step step1] by auto
            then have f12s1': "friends12 s1 = friends12 s1'"
              using step_friends12_φ[OF step1] by auto
            have "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
            then have "Δ1 s' vl' s1' vl1" using os aF1 vl vl1
              unfolding Δ1_def os' vl' f12s1' by auto
            then have ?match
              using step1 nφ' os eqButUID_step_γ_out[OF ss1 step step1]
              by (intro matchI[of s1 a ou1 s1' vl1 vl1]) (auto simp: consume_def)
            then show "?match ∨ ?ignore" ..
        next
          case False
            with nφ have "ou ≠ outOK" by auto
            then have "s' = s" using step False by auto
            then have ?ignore using 1 False UID1_UID2_UIDs unfolding vl' by (intro ignoreI) auto
            then show "?match ∨ ?ignore" ..
        qed
      qed
    qed
    then show ?thesis using fs1 unfolding vl1 by auto
  next
    assume "fs1 ≠ []"
    then obtain fs1' where fs1: "fs1 = (¬friends12 s1) # fs1'"
                       and aF1': "alternatingFriends (map FrVal fs1') (¬friends12 s1)"
      using aF1 unfolding vl1 by (cases fs1) auto
    obtain al oul s1' where "sstep s1 al = (oul, s1')" "al ≠ []" "eqButUID s1 s1'"
                            "friends12 s1' = (¬friends12 s1)"
                            "O (traceOf s1 al) = []" "V (traceOf s1 al) = [FrVal (¬friends12 s1)]"
      using rs1 IDs1
      by (cases "friends12 s1") (auto intro: toggle_friends12_True toggle_friends12_False)
    moreover then have "Δ1 s vl s1' (map FrVal fs1')"
      using os aF1' vl ss1 unfolding Δ1_def by (auto intro: eqButUID_sym eqButUID_trans)
    ultimately have ?iact using vl1 unfolding fs1
      by (intro iactionI_ms[of s1 al oul s1'])
         (auto simp: consumeList_def O_Nil_never list_ex_iff_length_V)
    then show ?thesis ..
  qed
qed

lemma unwind_cont_Δ2: "unwind_cont Δ2 {Δ2,Δ0}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ2 s vl s1 vl1 ∨ Δ0 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and 2: "Δ2 s vl s1 vl1"
  from rsT have rs: "reach s" by (intro reachNT_reach)
  obtain fs fs1 vlr vlr1
  where ss1: "eqButUID s s1" and os: "¬open s" and BO: "BO vlr vlr1"
    and aF1: "alternatingFriends vl1 (friends12 s1)"
    and vl:  "vl =  map FrVal fs  @ OVal True # vlr"
    and vl1: "vl1 = map FrVal fs1 @ OVal True # vlr1"
    and fs_fs1: "fs = [] ⟷ fs1 = []"
    and last_fs: "fs ≠ [] ⟶ last fs = last fs1"
    and fs_fIDs: "fs = [] ⟶ friendIDs s = friendIDs s1"
    using 2 unfolding Δ2_def by auto
  from os have IDs: "IDsOK s [UID1, UID2] [] [] []" unfolding open_defs by auto
  then have IDs1: "IDsOK s1 [UID1, UID2] [] [] []" using ss1 unfolding eqButUID_def by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof cases
    assume "length fs1 > 1"
    then obtain fs1'
    where fs1: "fs1 = (¬friends12 s1) # fs1'" and fs1': "fs1' ≠ []"
      and last_fs': "last fs1 = last fs1'"
      and aF1': "alternatingFriends (map FrVal fs1' @ OVal True # vlr1) (¬friends12 s1)"
      using vl1 aF1 by (cases fs1) auto
    obtain al oul s1' where "sstep s1 al = (oul, s1')" "al ≠ []" "eqButUID s1 s1'"
                            "friends12 s1' = (¬friends12 s1)"
                            "O (traceOf s1 al) = []" "V (traceOf s1 al) = [FrVal (¬friends12 s1)]"
      using rs1 IDs1
      by (cases "friends12 s1") (auto intro: toggle_friends12_True toggle_friends12_False)
    moreover then have "Δ2 s vl s1' (map FrVal fs1' @ OVal True # vlr1)"
      using os aF1' vl ss1 fs1' last_fs' fs_fs1 last_fs BO unfolding fs1
      by (intro Δ2_I[of _ _ vlr vlr1 _ fs fs1'])
         (auto intro: eqButUID_sym eqButUID_trans)
    ultimately have ?iact using vl1 unfolding fs1
      by (intro iactionI_ms[of s1 al oul s1'])
         (auto simp: consumeList_def O_Nil_never list_ex_iff_length_V)
    then show ?thesis ..
  next
    assume len1_leq_1: "¬ length fs1 > 1"
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof cases
        assume φ: "φ ?trn"
        show ?thesis proof cases
          assume "length fs > 1"
          then obtain fv fs'
          where fs1: "fs = fv # fs'" and fs1': "fs' ≠ []"
            and last_fs': "last fs = last fs'"
            using vl by (cases fs) auto
          with φ c have fv: "f ?trn = FrVal fv" and vl': "vl' = map FrVal fs' @ OVal True # vlr"
            unfolding vl consume_def by auto
          from φ step rs fv have ss': "eqButUID s s'"
            by (elim φE) (auto intro: Cact_cFriend_step_eqButUID Dact_dFriend_step_eqButUID)
          then have "¬open s'" using os by (auto simp: eqButUID_open_eq)
          moreover have "eqButUID s' s1" using ss1 ss' by (auto intro: eqButUID_sym eqButUID_trans)
          ultimately have "Δ2 s' vl' s1 vl1"
            using aF1 vl' fs1' fs_fs1 last_fs BO unfolding fs1 vl1
            by (intro Δ2_I[of _ _ vlr vlr1 _ fs' fs1])
               (auto intro: eqButUID_sym eqButUID_trans)
          moreover have "¬γ ?trn" using φ step rs fv UID1_UID2_UIDs by (elim φE) auto
          ultimately have ?ignore by (intro ignoreI) auto
          then show "?match ∨ ?ignore" ..
        next
          assume len_leq_1: "¬ length fs > 1"
          show ?thesis proof cases
            assume fs: "fs = []"
            then have fs1: "fs1 = []" and fIDs: "friendIDs s = friendIDs s1"
              using fs_fs1 fs_fIDs by auto
            from fs φ c have ov: "f ?trn = OVal True" and vl': "vl' = vlr"
              unfolding vl consume_def by auto
            with φ step rs have ?match proof (cases rule: φE)
              case (OpenF uid p uid')
                let ?s1' = "createFriend s1 uid p uid'"
                let ?trn1 = "Trans s1 a outOK ?s1'"
                have s': "s' = createFriend s uid p uid'" using OpenF step by auto
                have "eqButUIDf (pendingFReqs s) (pendingFReqs s1)"
                  using ss1 unfolding eqButUID_def by auto
                then have "uid' ∈∈ pendingFReqs s uid ⟷ uid' ∈∈ pendingFReqs s1 uid"
                  using OpenF by (intro eqButUIDf_not_UID') auto
                then have step1: "step s1 a = (outOK, ?s1')"
                  using OpenF step ss1 fIDs unfolding eqButUID_def by (auto simp: c_defs)
                have s's1': "eqButUID s' ?s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
                moreover have os': "open s'" using OpenF unfolding open_def by auto
                moreover have fIDs': "friendIDs s' = friendIDs ?s1'"
                  using fIDs unfolding s' by (auto simp: c_defs)
                moreover have f12s1: "friends12 s1 = friends12 ?s1'"
                  using OpenF(2) UID1_UID2_UIDs unfolding friends12_def c_defs by auto
                ultimately have "Δ0 s' vl' ?s1' vlr1"
                  using BO aF1 unfolding Δ0_def vl' vl1 fs1 by auto
                moreover have "¬open s1" "open ?s1'"
                  using ss1 os s's1' os' by (auto simp: eqButUID_open_eq)
                moreover then have "φ ?trn1" unfolding OpenF by auto
                ultimately show ?match using step1 vl1 fs1 OpenF UID1_UID2 UID1_UID2_UIDs
                  by (intro matchI[of s1 a outOK ?s1' vl1 vlr1]) (auto simp: consume_def)
            qed auto
            then show ?thesis ..
          next
            assume "fs ≠ []"
            then obtain fv where fs: "fs = [fv]" using len_leq_1 by (cases fs) auto
            then have fs1: "fs1 = [fv]" using len1_leq_1 fs_fs1 last_fs by (cases fs1) auto
            with aF1 have f12s1: "friends12 s1 = (¬fv)" unfolding vl1 by auto
            have fv: "f ?trn = FrVal fv" and vl': "vl' = OVal True # vlr"
              using c φ unfolding vl fs by (auto simp: consume_def)
            with φ step rs have ?match proof (cases rule: φE)
              case (Friend uid p uid')
                then have IDs1: "IDsOK s1 [UID1, UID2] [] [] []"
                  using ss1 unfolding eqButUID_def by auto
                have fv: "fv = True" using fv Friend by auto
                let ?s1' = "createFriend s1 UID1 (pass s1 UID1) UID2"
                have s': "s' = createFriend s UID1 p UID2"
                  using Friend step by (auto simp: createFriend_sym)
                have ss': "eqButUID s s'" using rs step Friend
                  by (auto intro: Cact_cFriend_step_eqButUID)
                moreover then have os': "¬open s'" using os eqButUID_open_eq by auto
                moreover obtain al oul where al: "sstep s1 al = (oul, ?s1')" "al ≠ []"
                                         and tr1: "O (traceOf s1 al) = []"
                                                  "V (traceOf s1 al) = [FrVal True]"
                                         and f12s1': "friends12 ?s1'"
                                         and s1s1': "eqButUID s1 ?s1'"
                  using rs1 IDs1 Friend f12s1 unfolding fv by (auto elim: toggle_friends12_True)
                moreover have "friendIDs s' = friendIDs ?s1'"
                  using Friend(6) f12s1 unfolding s' fv
                  by (intro eqButUID_createFriend12_friendIDs_eq[OF ss1 rs rs1]) auto
                ultimately have "Δ2 s' vl' ?s1' (OVal True # vlr1)"
                  using BO ss1 aF1 unfolding vl' vl1 fs1 f12s1 fv
                  by (intro Δ2_I[of _ _ _ _ _ "[]" "[]"])
                     (auto intro: eqButUID_trans eqButUID_sym)
                then show ?match using tr1 vl1 Friend UID1_UID2_UIDs unfolding fs1 fv
                  by (intro matchI_ms[OF al]) (auto simp: consumeList_def)
            next
              case (Unfriend uid p uid')
                then have IDs1: "IDsOK s1 [UID1, UID2] [] [] []"
                  using ss1 unfolding eqButUID_def by auto
                have fv: "fv = False" using fv Unfriend by auto
                let ?s1' = "deleteFriend s1 UID1 (pass s1 UID1) UID2"
                have s': "s' = deleteFriend s UID1 p UID2"
                  using Unfriend step by (auto simp: deleteFriend_sym)
                have ss': "eqButUID s s'" using rs step Unfriend
                  by (auto intro: Dact_dFriend_step_eqButUID)
                moreover then have os': "¬open s'" using os eqButUID_open_eq by auto
                moreover obtain al oul where al: "sstep s1 al = (oul, ?s1')" "al ≠ []"
                                         and tr1: "O (traceOf s1 al) = []"
                                                  "V (traceOf s1 al) = [FrVal False]"
                                         and f12s1': "¬friends12 ?s1'"
                                         and s1s1': "eqButUID s1 ?s1'"
                  using rs1 IDs1 Unfriend f12s1 unfolding fv by (auto elim: toggle_friends12_False)
                moreover have "friendIDs s' = friendIDs ?s1'"
                  using Unfriend(6) f12s1 unfolding s' fv
                  by (intro eqButUID_deleteFriend12_friendIDs_eq[OF ss1 rs rs1])
                ultimately have "Δ2 s' vl' ?s1' (OVal True # vlr1)"
                  using BO ss1 aF1 unfolding vl' vl1 fs1 f12s1 fv
                  by (intro Δ2_I[of _ _ _ _ _ "[]" "[]"])
                     (auto intro: eqButUID_trans eqButUID_sym)
                then show ?match using tr1 vl1 Unfriend UID1_UID2_UIDs unfolding fs1 fv
                  by (intro matchI_ms[OF al]) (auto simp: consumeList_def)
            qed auto
            then show ?thesis ..
          qed
        qed
      next
        assume nφ: "¬φ ?trn"
        then have os': "open s = open s'" and f12s': "friends12 s = friends12 s'"
          using step_open_φ[OF step] step_friends12_φ[OF step] by auto
        have vl': "vl' = vl" using nφ c by (auto simp: consume_def)
        show ?thesis proof (cases "a ≠ Cact (cFriend UID1 (pass s UID1) UID2) ∧
                                   a ≠ Cact (cFriend UID2 (pass s UID2) UID1) ∧
                                   a ≠ Dact (dFriend UID1 (pass s UID1) UID2) ∧
                                   a ≠ Dact (dFriend UID2 (pass s UID2) UID1)")
          case True
            obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by (cases "step s1 a") auto
            let ?trn1 = "Trans s1 a ou1 s1'"
            from True nφ have nφ': "¬φ ?trn1" using eqButUID_step_φ[OF ss1 rs rs1 step step1] by auto
            then have f12s1': "friends12 s1 = friends12 s1'"
              using step_friends12_φ[OF step1] by auto
            have "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
            moreover have "friendIDs s = friendIDs s1 ⟶ friendIDs s' = friendIDs s1'"
              using eqButUID_step_friendIDs_eq[OF ss1 rs rs1 step step1 True] ..
            ultimately have "Δ2 s' vl' s1' vl1"
              using os' os aF1 BO fs_fs1 last_fs fs_fIDs unfolding f12s1' vl' vl vl1
              by (intro Δ2_I) auto
            then have ?match
              using step1 nφ' os eqButUID_step_γ_out[OF ss1 step step1]
              by (intro matchI[of s1 a ou1 s1' vl1 vl1]) (auto simp: consume_def)
            then show "?match ∨ ?ignore" ..
        next
          case False
            with nφ have "ou ≠ outOK" by auto
            then have "s' = s" using step False by auto
            then have ?ignore using 2 False UID1_UID2_UIDs unfolding vl' by (intro ignoreI) auto
            then show "?match ∨ ?ignore" ..
        qed
      qed
    qed
    then show ?thesis unfolding vl by auto
  qed
qed


definition Gr where
"Gr =
 {
 (Δ0, {Δ0,Δ1,Δ2}),
 (Δ1, {Δ1,Δ0}),
 (Δ2, {Δ2,Δ0})
 }"


theorem secure: secure
apply (rule unwind_decomp_secure_graph[of Gr Δ0])
unfolding Gr_def
apply (simp, smt insert_subset order_refl)
using
istate_Δ0 unwind_cont_Δ0 unwind_cont_Δ1 unwind_cont_Δ2
unfolding Gr_def by (auto intro: unwind_cont_mono)

end

end
body>

Theory Friend_Network

theory Friend_Network
  imports
    "../API_Network"
    "Friend"
    "BD_Security_Compositional.Composing_Security_Network"
begin

subsection ‹Confidentiality for the N-ary composition›

locale FriendNetwork = Network + FriendNetworkObservationSetup +
fixes
  AID :: apiID
and
  UID1 :: userID
and
  UID2 :: userID
assumes
  UID1_UID2_UIDs: "{UID1,UID2} ∩ (UIDs AID) = {}"
and
  UID1_UID2: "UID1 ≠ UID2"
and
  AID_AIDs: "AID ∈ AIDs"
begin

sublocale Issuer: Friend "UIDs AID" UID1 UID2 using UID1_UID2_UIDs UID1_UID2 by unfold_locales

abbreviation φ :: "apiID ⇒ (state, act, out) trans ⇒ bool"
where "φ aid trn ≡ (Issuer.φ trn ∧ aid = AID)"

abbreviation f :: "apiID ⇒ (state, act, out) trans ⇒ Friend.value"
where "f aid trn ≡ Friend.f UID1 UID2 trn"

abbreviation T :: "apiID ⇒ (state, act, out) trans ⇒ bool"
where "T aid trn ≡ False"

abbreviation B :: "apiID ⇒ Friend.value list ⇒ Friend.value list ⇒ bool"
where "B aid vl vl1 ≡ (if aid = AID then Issuer.B vl vl1 else (vl = [] ∧ vl1 = []))"

abbreviation "comOfV aid vl ≡ Internal"
abbreviation "tgtNodeOfV aid vl ≡ undefined"
abbreviation "syncV aid1 vl1 aid2 vl2 ≡ False"

lemma [simp]: "validTrans aid trn ⟹ lreach aid (srcOf trn) ⟹ φ aid trn ⟹ comOf aid trn = Internal"
by (cases trn) (auto elim: Issuer.φE)

sublocale Net: BD_Security_TS_Network_getTgtV
where istate = "λ_. istate" and validTrans = validTrans and srcOf = "λ_. srcOf" and tgtOf = "λ_. tgtOf"
  and nodes = AIDs and comOf = comOf and tgtNodeOf = tgtNodeOf
  and sync = sync and φ = φ and f = f and γ = γ and g = g and T = T and B = B
  and comOfV = comOfV and tgtNodeOfV = tgtNodeOfV and syncV = syncV
  and comOfO = comOfO and tgtNodeOfO = tgtNodeOfO and syncO = syncO (*and cmpO = cmpO*)
  and source = AID and getTgtV = id
proof (unfold_locales, goal_cases)
  case (1 aid trn) then show ?case by auto next
  case (2 aid trn) then show ?case by auto next
  case (3 aid trn) then show ?case by (cases trn) auto next
  case (4 aid trn) then show ?case by (cases "(aid,trn)" rule: tgtNodeOf.cases) auto next
  case (5 aid1 trn1 aid2 trn2) then show ?case by auto next
  case (6 aid1 trn1 aid2 trn2) then show ?case by (cases trn1; cases trn2; auto) next
  case (7 aid1 trn1 aid2 trn2) then show ?case by auto next
  case (8 aid1 trn1 aid2 trn2) then show ?case by (cases trn1; cases trn2; auto) next
  case (9 aid trn) then show ?case by (cases "(aid,trn)" rule: tgtNodeOf.cases) (auto simp: FriendObservationSetup.γ.simps) next
  case (10 aid trn) then show ?case by auto
qed auto

sublocale BD_Security_TS_Network_Preserve_Source_Security_getTgtV
where istate = "λ_. istate" and validTrans = validTrans and srcOf = "λ_. srcOf" and tgtOf = "λ_. tgtOf"
  and nodes = AIDs and comOf = comOf and tgtNodeOf = tgtNodeOf
  and sync = sync and φ = φ and f = f and γ = γ and g = g and T = T and B = B
  and comOfV = comOfV and tgtNodeOfV = tgtNodeOfV and syncV = syncV
  and comOfO = comOfO and tgtNodeOfO = tgtNodeOfO and syncO = syncO (*and cmpO = cmpO*)
  and source = AID and getTgtV = id
using AID_AIDs Issuer.secure
by unfold_locales auto

theorem secure: "secure"
proof (intro preserve_source_secure ballI)
  fix aid
  assume "aid ∈ AIDs - {AID}"
  then show "Net.lsecure aid" by (intro Abstract_BD_Security.B_id_secure) (auto simp: B_id_def)
qed

end

end
>

Theory Friend_All

theory Friend_All
imports Friend_Network
begin


end
d>

Theory Friend_Request_Intro

theory Friend_Request_Intro
  imports
    "../Friend_Confidentiality/Friend_Openness"
    "../Friend_Confidentiality/Friend_State_Indistinguishability"
begin

section ‹Friendship request confidentiality›

text ‹
We verify the following property:

\ \\
Given a coalition consisting of groups of users ‹UIDs j› from multiple nodes ‹j›
and given two users ‹UID1› and ‹UID2› at some node ‹i› who are not in these groups,

the coalition cannot learn anything about the the friendship requests issued between
‹UID1› and ‹UID2›

beyond what everybody knows, namely that
  ▪ every successful friend creation is preceded by at least one and at most two requests, and
  ▪ friendship status updates form an alternating sequence of friending and unfriending,

and beyond the existence of requests issued while or last before
a user in the group ‹UIDs i› is a local friend of ‹UID1› or ‹UID2›.

\ \\
The approach here is similar to that for friendship status confidentiality
(explained in the introduction of Section~\ref{sec:friend}).
Like in the case of friendship status, here secret information is not communicated
between different nodes (so again we don't need to distinguish between an issuer node
and the other, receiver nodes).
›

end

Theory Friend_Request_Value_Setup

(* The value setup for friendship request confidentiality *)
theory Friend_Request_Value_Setup
  imports Friend_Request_Intro
begin

subsection ‹Value setup›

context Friend
begin

datatype "fUser" = U1 | U2
datatype "value" =
  isFRVal: FRVal fUser requestInfo ― ‹friendship requests from ‹UID1› to ‹UID2› (or vice versa)›
| isFVal: FVal bool ― ‹updated friendship status between ‹UID1› and ‹UID2››
| isOVal: OVal bool ― ‹updated dynamic declassification trigger condition›

fun φ :: "(state,act,out) trans ⇒ bool" where
"φ (Trans s (Cact (cFriendReq uid p uid' req)) ou s') =
  ((uid,uid') ∈ {(UID1,UID2), (UID2,UID1)} ∧ ou = outOK)"
|
"φ (Trans s (Cact (cFriend uid p uid')) ou s') =
  ((uid,uid') ∈ {(UID1,UID2), (UID2,UID1)} ∧ ou = outOK ∨
   open s ≠ open s')"
|
"φ (Trans s (Dact (dFriend uid p uid')) ou s') =
  ((uid,uid') ∈ {(UID1,UID2), (UID2,UID1)} ∧ ou = outOK ∨
   open s ≠ open s')"
|
"φ (Trans s (Cact (cUser uid p uid' p')) ou s') =
  (open s ≠ open s')"
|
"φ _ = False"

fun f :: "(state,act,out) trans ⇒ value" where
"f (Trans s (Cact (cFriendReq uid p uid' req)) ou s') =
    (if uid = UID1 ∧ uid' = UID2 then FRVal U1 req
else if uid = UID2 ∧ uid' = UID1 then FRVal U2 req
                                 else OVal True)"
|
"f (Trans s (Cact (cFriend uid p uid')) ou s') =
  (if (uid,uid') ∈ {(UID1,UID2), (UID2,UID1)} then FVal True
                                              else OVal True)"
|
"f (Trans s (Dact (dFriend uid p uid')) ou s') =
  (if (uid,uid') ∈ {(UID1,UID2), (UID2,UID1)} then FVal False
                                              else OVal False)"
|
"f (Trans s (Cact (cUser uid p uid' p')) ou s') = OVal False"
|
"f _ = undefined"

lemma φE:
assumes φ: "φ (Trans s a ou s')" (is "φ ?trn")
and step: "step s a = (ou, s')"
and rs: "reach s"
obtains (FReq1) u p req where "a = Cact (cFriendReq UID1 p UID2 req)" "ou = outOK"
                              "f ?trn = FRVal u req" "u = U1" "IDsOK s [UID1, UID2] [] [] []"
                              "¬friends12 s" "¬friends12 s'" "open s' = open s"
                              "UID1 ∈∈ pendingFReqs s' UID2" "UID1 ∉ set (pendingFReqs s UID2)"
                              "UID2 ∈∈ pendingFReqs s' UID1 ⟷ UID2 ∈∈ pendingFReqs s UID1"
      | (FReq2) u p req where "a = Cact (cFriendReq UID2 p UID1 req)" "ou = outOK"
                              "f ?trn = FRVal u req" "u = U2" "IDsOK s [UID1, UID2] [] [] []"
                              "¬friends12 s" "¬friends12 s'" "open s' = open s"
                              "UID2 ∈∈ pendingFReqs s' UID1" "UID2 ∉ set (pendingFReqs s UID1)"
                              "UID1 ∈∈ pendingFReqs s' UID2 ⟷ UID1 ∈∈ pendingFReqs s UID2"
      | (Friend) uid p uid' where "a = Cact (cFriend uid p uid')" "ou = outOK" "f ?trn = FVal True"
                                  "uid = UID1 ∧ uid' = UID2 ∨ uid = UID2 ∧ uid' = UID1"
                                  "IDsOK s [UID1, UID2] [] [] []"
                                  "¬friends12 s" "friends12 s'" "uid' ∈∈ pendingFReqs s uid"
                                  "UID1 ∉ set (pendingFReqs s' UID2)"
                                  "UID2 ∉ set (pendingFReqs s' UID1)"
      | (Unfriend) uid p uid' where "a = Dact (dFriend uid p uid')" "ou = outOK" "f ?trn = FVal False"
                                    "uid = UID1 ∧ uid' = UID2 ∨ uid = UID2 ∧ uid' = UID1"
                                    "IDsOK s [UID1, UID2] [] [] []"
                                    "friends12 s" "¬friends12 s'"
                                    "UID1 ∉ set (pendingFReqs s' UID2)"
                                    "UID1 ∉ set (pendingFReqs s UID2)"
                                    "UID2 ∉ set (pendingFReqs s' UID1)"
                                    "UID2 ∉ set (pendingFReqs s UID1)"
      | (OpenF) uid p uid' where "a = Cact (cFriend uid p uid')"
                                 "(uid ∈ UIDs ∧ uid' ∈ {UID1,UID2}) ∨ (uid' ∈ UIDs ∧ uid ∈ {UID1,UID2})"
                                 "ou = outOK" "f ?trn = OVal True" "¬openByF s" "openByF s'"
                                 "¬openByA s" "¬openByA s'"
                                 "friends12 s' = friends12 s"
                                 "UID1 ∈∈ pendingFReqs s' UID2 ⟷ UID1 ∈∈ pendingFReqs s UID2"
                                 "UID2 ∈∈ pendingFReqs s' UID1 ⟷ UID2 ∈∈ pendingFReqs s UID1"
      | (CloseF) uid p uid' where "a = Dact (dFriend uid p uid')"
                                  "(uid ∈ UIDs ∧ uid' ∈ {UID1,UID2}) ∨ (uid' ∈ UIDs ∧ uid ∈ {UID1,UID2})"
                                  "ou = outOK" "f ?trn = OVal False" "openByF s" "¬openByF s'"
                                  "¬openByA s" "¬openByA s'"
                                  "friends12 s' = friends12 s"
                                  "UID1 ∈∈ pendingFReqs s' UID2 ⟷ UID1 ∈∈ pendingFReqs s UID2"
                                  "UID2 ∈∈ pendingFReqs s' UID1 ⟷ UID2 ∈∈ pendingFReqs s UID1"
      | (CloseA) uid p uid' p' where "a = Cact (cUser uid p uid' p')"
                                     "uid' ∈ {UID1,UID2}" "openByA s" "¬openByA s'"
                                     "¬openByF s" "¬openByF s'"
                                     "ou = outOK" "f ?trn = OVal False"
                                     "friends12 s' = friends12 s"
                                     "UID1 ∈∈ pendingFReqs s' UID2 ⟷ UID1 ∈∈ pendingFReqs s UID2"
                                     "UID2 ∈∈ pendingFReqs s' UID1 ⟷ UID2 ∈∈ pendingFReqs s UID1"
using φ proof (elim φ.elims disjE conjE)
  fix s1 uid p uid' req ou1 s1'
  assume "(uid,uid') ∈ {(UID1,UID2), (UID2,UID1)}" and ou: "ou1 = outOK"
     and "?trn = Trans s1 (Cact (cFriendReq uid p uid' req)) ou1 s1'"
  then have trn: "a = Cact (cFriendReq uid p uid' req)" "s = s1" "s' = s1'" "ou = ou1"
        and uids: "uid = UID1 ∧ uid' = UID2 ∨ uid = UID2 ∧ uid' = UID1" using UID1_UID2 by auto
  from uids show thesis proof
    assume "uid = UID1 ∧ uid' = UID2"
    then show thesis using ou uids trn step UID1_UID2_UIDs UID1_UID2 reach_distinct_friends_reqs[OF rs]
      by (intro FReq1[of p req]) (auto simp add: c_defs friends12_def open_defs)
  next
    assume "uid = UID2 ∧ uid' = UID1"
    then show thesis using ou uids trn step UID1_UID2_UIDs UID1_UID2 reach_distinct_friends_reqs[OF rs]
      by (intro FReq2[of p req]) (auto simp add: c_defs friends12_def open_defs)
  qed
next
  fix s1 uid p uid' ou1 s1'
  assume "(uid,uid') ∈ {(UID1,UID2), (UID2,UID1)}" and ou: "ou1 = outOK"
     and "?trn = Trans s1 (Cact (cFriend uid p uid')) ou1 s1'"
  then have trn: "a = Cact (cFriend uid p uid')" "s = s1" "s' = s1'" "ou = ou1"
        and uids: "uid = UID1 ∧ uid' = UID2 ∨ uid = UID2 ∧ uid' = UID1" using UID1_UID2 by auto
  then show thesis using ou uids trn step UID1_UID2_UIDs UID1_UID2 reach_distinct_friends_reqs[OF rs]
    by (intro Friend[of uid p uid']) (auto simp add: c_defs friends12_def)
next
  fix s1 uid p uid' ou1 s1'
  assume op: "open s1 ≠ open s1'"
     and "?trn = Trans s1 (Cact (cFriend uid p uid')) ou1 s1'"
  then have trn: "open s ≠ open s'" "a = Cact (cFriend uid p uid')" "s = s1" "s' = s1'" "ou = ou1"
    by auto
  with step have uids: "(uid ∈ UIDs ∧ uid' ∈ {UID1, UID2} ∨ uid ∈ {UID1, UID2} ∧ uid' ∈ UIDs) ∧
                        ou = outOK ∧ p = pass s uid ∧
                        ¬openByF s ∧ openByF s' ∧ ¬openByA s ∧ ¬openByA s'"
    by (cases rule: step_open_cases) auto
  moreover have "friends12 s' ⟷ friends12 s"
    using step_friendIDs[OF step, of UID1 UID2] trn uids UID1_UID2 UID1_UID2_UIDs
    by (auto simp add: friends12_def)
  moreover have "(UID1 ∈∈ pendingFReqs s' UID2 ⟷ UID1 ∈∈ pendingFReqs s UID2) ∧
                 (UID2 ∈∈ pendingFReqs s' UID1 ⟷ UID2 ∈∈ pendingFReqs s UID1)"
    using step_pendingFReqs[OF step, of UID1 UID2] trn uids UID1_UID2 UID1_UID2_UIDs
    by auto
  ultimately show thesis using trn(2) step UID1_UID2_UIDs UID1_UID2 by (intro OpenF) auto
next
  fix s1 uid p uid' ou1 s1'
  assume "(uid,uid') ∈ {(UID1,UID2), (UID2,UID1)}" and ou: "ou1 = outOK"
     and "?trn = Trans s1 (Dact (dFriend uid p uid')) ou1 s1'"
  then have trn: "a = Dact (dFriend uid p uid')" "s = s1" "s' = s1'" "ou = ou1"
        and uids: "uid = UID1 ∧ uid' = UID2 ∨ uid = UID2 ∧ uid' = UID1" using UID1_UID2 by auto
  then show thesis using step ou reach_friendIDs_symmetric[OF rs] reach_distinct_friends_reqs[OF rs]
    by (intro Unfriend; auto simp: d_defs friends12_def) blast+
next
  fix s1 uid p uid' ou1 s1'
  assume op: "open s1 ≠ open s1'"
     and "?trn = Trans s1 (Dact (dFriend uid p uid')) ou1 s1'"
  then have trn: "open s ≠ open s'" "a = Dact (dFriend uid p uid')" "s = s1" "s' = s1'" "ou = ou1"
    by auto
  with step have uids: "(uid ∈ UIDs ∧ uid' ∈ {UID1, UID2} ∨ uid ∈ {UID1, UID2} ∧ uid' ∈ UIDs) ∧
                   ou = outOK ∧ openByF s ∧ ¬openByF s' ∧ ¬openByA s ∧ ¬openByA s'"
    by (cases rule: step_open_cases) auto
  moreover have "friends12 s' ⟷ friends12 s"
    using step_friendIDs[OF step, of UID1 UID2] trn uids UID1_UID2 UID1_UID2_UIDs
    by (auto simp add: friends12_def)
  moreover have "(UID1 ∈∈ pendingFReqs s' UID2 ⟷ UID1 ∈∈ pendingFReqs s UID2) ∧
                 (UID2 ∈∈ pendingFReqs s' UID1 ⟷ UID2 ∈∈ pendingFReqs s UID1)"
    using step_pendingFReqs[OF step, of UID1 UID2] trn uids UID1_UID2 UID1_UID2_UIDs
    by auto
  ultimately show thesis using trn(1,2) step UID1_UID2 UID1_UID2_UIDs
    by (intro CloseF) auto
next
  fix s1 uid p uid' p' ou1 s1'
  assume op: "open s1 ≠ open s1'"
     and "?trn = Trans s1 (Cact (cUser uid p uid' p')) ou1 s1'"
  then have trn: "open s ≠ open s'" "a = Cact (cUser uid p uid' p')" "s = s1" "s' = s1'" "ou = ou1"
    by auto
  with step have uids: "(uid' = UID2 ∨ uid' = UID1) ∧ ou = outOK ∧
                       ¬openByF s1 ∧ ¬openByF s1' ∧ openByA s1 ∧ ¬openByA s1'"
    by (cases rule: step_open_cases) auto
  moreover have "friends12 s1' ⟷ friends12 s1"
    using step_friendIDs[OF step, of UID1 UID2] trn uids UID1_UID2 UID1_UID2_UIDs
    by (auto simp add: friends12_def)
  moreover have "(UID1 ∈∈ pendingFReqs s' UID2 ⟷ UID1 ∈∈ pendingFReqs s UID2) ∧
                 (UID2 ∈∈ pendingFReqs s' UID1 ⟷ UID2 ∈∈ pendingFReqs s UID1)"
    using step_pendingFReqs[OF step, of UID1 UID2] trn uids UID1_UID2 UID1_UID2_UIDs
    by auto
  ultimately show thesis using trn step UID1_UID2_UIDs UID1_UID2 by (intro CloseA) auto
qed

lemma step_open_φ:
assumes "step s a = (ou, s')"
and "open s ≠ open s'"
shows "φ (Trans s a ou s')"
using assms by (cases rule: step_open_cases) (auto simp: open_def)

lemma step_friends12_φ:
assumes "step s a = (ou, s')"
and "friends12 s ≠ friends12 s'"
shows "φ (Trans s a ou s')"
proof -
  have "a = Cact (cFriend UID1 (pass s UID1) UID2) ∨ a = Cact (cFriend UID2 (pass s UID2) UID1) ∨
        a = Dact (dFriend UID1 (pass s UID1) UID2) ∨ a = Dact (dFriend UID2 (pass s UID2) UID1)"
   using assms step_friends12 by auto
  moreover then have "ou = outOK" using assms by auto
  ultimately show "φ (Trans s a ou s')" by auto
qed

lemma step_pendingFReqs_φ:
assumes "step s a = (ou, s')"
and "(UID1 ∈∈ pendingFReqs s UID2) ≠ (UID1 ∈∈ pendingFReqs s' UID2)
   ∨ (UID2 ∈∈ pendingFReqs s UID1) ≠ (UID2 ∈∈ pendingFReqs s' UID1)"
shows "φ (Trans s a ou s')"
proof -
  have "∃req. a = Cact (cFriend UID1 (pass s UID1) UID2) ∨
              a = Cact (cFriend UID2 (pass s UID2) UID1) ∨
              a = Dact (dFriend UID1 (pass s UID1) UID2) ∨
              a = Dact (dFriend UID2 (pass s UID2) UID1) ∨
              a = Cact (cFriendReq UID1 (pass s UID1) UID2 req) ∨
              a = Cact (cFriendReq UID2 (pass s UID2) UID1 req)"
    by (rule ccontr, insert assms step_pendingFReqs) auto
  moreover then have "ou = outOK" using assms by auto
  ultimately show "φ (Trans s a ou s')" by auto
qed

lemma eqButUID_step_φ_imp:
assumes ss1: "eqButUID s s1"
and rs: "reach s" and rs1: "reach s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and a: "∀req. a ≠ Cact (cFriend UID1 (pass s UID1) UID2) ∧
              a ≠ Cact (cFriend UID2 (pass s UID2) UID1) ∧
              a ≠ Cact (cFriendReq UID1 (pass s UID1) UID2 req) ∧
              a ≠ Cact (cFriendReq UID2 (pass s UID2) UID1 req) ∧
              a ≠ Dact (dFriend UID1 (pass s UID1) UID2) ∧
              a ≠ Dact (dFriend UID2 (pass s UID2) UID1)"
and φ: "φ (Trans s a ou s')"
shows "φ (Trans s1 a ou1 s1')"
proof -
  have "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
  then have "open s = open s1" and "open s' = open s1'"
        and "openByA s = openByA s1" and "openByA s' = openByA s1'"
        and "openByF s = openByF s1" and "openByF s' = openByF s1'"
    using ss1 by (auto simp: eqButUID_open_eq eqButUID_openByA_eq eqButUID_openByF_eq)
  with φ a step step1 show "φ (Trans s1 a ou1 s1')" using UID1_UID2_UIDs
    by (elim φ.elims) (auto simp: c_defs d_defs)
qed

lemma eqButUID_step_φ:
assumes ss1: "eqButUID s s1"
and rs: "reach s" and rs1: "reach s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and a: "∀req. a ≠ Cact (cFriend UID1 (pass s UID1) UID2) ∧
              a ≠ Cact (cFriend UID2 (pass s UID2) UID1) ∧
              a ≠ Cact (cFriendReq UID1 (pass s UID1) UID2 req) ∧
              a ≠ Cact (cFriendReq UID2 (pass s UID2) UID1 req) ∧
              a ≠ Dact (dFriend UID1 (pass s UID1) UID2) ∧
              a ≠ Dact (dFriend UID2 (pass s UID2) UID1)"
shows "φ (Trans s a ou s') = φ (Trans s1 a ou1 s1')"
proof
  assume "φ (Trans s a ou s')"
  with assms show "φ (Trans s1 a ou1 s1')" by (rule eqButUID_step_φ_imp)
next
  assume "φ (Trans s1 a ou1 s1')"
  moreover have "eqButUID s1 s" using ss1 by (rule eqButUID_sym)
  moreover have "∀req. a ≠ Cact (cFriend UID1 (pass s1 UID1) UID2) ∧
                       a ≠ Cact (cFriend UID2 (pass s1 UID2) UID1) ∧
                       a ≠ Cact (cFriendReq UID1 (pass s1 UID1) UID2 req) ∧
                       a ≠ Cact (cFriendReq UID2 (pass s1 UID2) UID1 req) ∧
                       a ≠ Dact (dFriend UID1 (pass s1 UID1) UID2) ∧
                       a ≠ Dact (dFriend UID2 (pass s1 UID2) UID1)"
    using a ss1 unfolding eqButUID_def by auto
  ultimately show "φ (Trans s a ou s')" using rs rs1 step step1
    by (intro eqButUID_step_φ_imp[of s1 s])
qed

end

end
body>

Theory Friend_Request

theory Friend_Request
  imports
    "Friend_Request_Value_Setup"
    "Bounded_Deducibility_Security.Compositional_Reasoning"
begin

subsection ‹Declassification bound›

context Friend
begin

fun T :: "(state,act,out) trans ⇒ bool"
where "T trn = False"

text ‹Friendship updates form an alternating sequence of friending and unfriending,
and every successful friend creation is preceded by one or two friendship requests.›

fun validValSeq :: "value list ⇒ bool ⇒ bool ⇒ bool ⇒ bool" where
  "validValSeq [] _ _ _ = True"
| "validValSeq (FRVal U1 req # vl) st r1 r2 ⟷ (¬st) ∧ (¬r1) ∧ validValSeq vl st True r2"
| "validValSeq (FRVal U2 req # vl) st r1 r2 ⟷ (¬st) ∧ (¬r2) ∧ validValSeq vl st r1 True"
| "validValSeq (FVal True # vl) st r1 r2 ⟷ (¬st) ∧ (r1 ∨ r2) ∧ validValSeq vl True False False"
| "validValSeq (FVal False # vl) st r1 r2 ⟷ st ∧ (¬r1) ∧ (¬r2) ∧ validValSeq vl False False False"
| "validValSeq (OVal True # vl) st r1 r2 ⟷ validValSeq vl st r1 r2"
| "validValSeq (OVal False # vl) st r1 r2 ⟷ validValSeq vl st r1 r2"

abbreviation validValSeqFrom :: "value list ⇒ state ⇒ bool"
where "validValSeqFrom vl s
 ≡ validValSeq vl (friends12 s) (UID1 ∈∈ pendingFReqs s UID2) (UID2 ∈∈ pendingFReqs s UID1)"

text ‹With respect to the friendship status updates, we use the same
``while-or-last-before'' bound as for friendship status confidentiality.›

inductive BO :: "value list ⇒ value list ⇒ bool"
and BC :: "value list ⇒ value list ⇒ bool"
where
 BO_FVal[simp,intro!]:
  "BO (map FVal fs) (map FVal fs)"
|BO_BC[intro]:
  "BC vl vl1 ⟹
   BO (map FVal fs @ OVal False # vl) (map FVal fs @ OVal False # vl1)"
(*  *)
|BC_FVal[simp,intro!]:
  "BC (map FVal fs) (map FVal fs1)"
|BC_BO[intro]:
  "BO vl vl1 ⟹ (fs = [] ⟷ fs1 = []) ⟹ (fs ≠ [] ⟹ last fs = last fs1) ⟹
   BC (map FVal fs  @ OVal True # vl)
      (map FVal fs1 @ OVal True # vl1)"

text ‹Taking into account friendship requests, two value sequences ‹vl› and ‹vl1› are in the bound if
  ▪ ‹vl1› (with friendship requests) forms a valid value sequence,
  ▪ ‹vl› and ‹vl1› are in ‹BO› (without friendship requests),
  ▪ ‹vl1› is empty if ‹vl› is empty, and
  ▪ ‹vl1› begins with term‹OVal False› if ‹vl› begins with term‹OVal False›.

The last two points are due to the fact that term‹UID1› and term‹UID1› might not exist yet
if ‹vl› is empty (or before term‹OVal False›), in which case the observer can deduce that no
friendship request has happened yet.›

definition "B vl vl1 ≡ BO (filter (Not o isFRVal) vl) (filter (Not o isFRVal) vl1) ∧
                       validValSeqFrom vl1 istate ∧
                       (vl = [] ⟶ vl1 = []) ∧
                       (vl ≠ [] ∧ hd vl = OVal False ⟶ vl1 ≠ [] ∧ hd vl1 = OVal False)"


lemma BO_Nil_iff: "BO vl vl1 ⟹ vl = [] ⟷ vl1 = []"
by (cases rule: BO.cases) auto


sublocale BD_Security_IO where
istate = istate and step = step and
φ = φ and f = f and γ = γ and g = g and T = T and B = B
done

subsection ‹Unwinding proof›

(* sanity check *) lemma validFrom_validValSeq:
assumes "validFrom s tr"
and "reach s"
shows "validValSeqFrom (V tr) s"
using assms proof (induction tr arbitrary: s)
  case (Cons trn tr s)
    then obtain a ou s' where trn: "trn = Trans s a ou s'"
                          and step: "step s a = (ou, s')"
                          and tr: "validFrom s' tr"
                          and s': "reach s'"
      by (cases trn) (auto iff: validFrom_Cons intro: reach_PairI)
    then have vVS_tr: "validValSeqFrom (V tr) s'" by (intro Cons.IH)
    show ?case proof cases
      assume φ: "φ (Trans s a ou s')"
      then have V: "V (Trans s a ou s' # tr) = f (Trans s a ou s') # V tr" by auto
      from φ vVS_tr Cons.prems step show ?thesis unfolding trn V by (elim φE) auto
    next
      assume "¬φ (Trans s a ou s')"
      then have "V (Trans s a ou s' # tr) = V tr" and "friends12 s' = friends12 s"
            and "UID1 ∈∈ pendingFReqs s' UID2 ⟷ UID1 ∈∈ pendingFReqs s UID2"
            and "UID2 ∈∈ pendingFReqs s' UID1 ⟷ UID2 ∈∈ pendingFReqs s UID1"
        using step_friends12_φ[OF step] step_pendingFReqs_φ[OF step] by auto
      with vVS_tr show ?thesis unfolding trn by auto
    qed
qed auto

lemma "validFrom istate tr ⟹ validValSeqFrom (V tr) istate"
using validFrom_validValSeq[of istate] reach.Istate unfolding istate_def friends12_def
by auto


(* helper *) lemma produce_FRVal:
assumes rs: "reach s"
and IDs: "IDsOK s [UID1, UID2] [] [] []"
and vVS: "validValSeqFrom (FRVal u req # vl) s"
obtains a uid uid' s'
where "step s a = (outOK, s')"
  and "a = Cact (cFriendReq uid (pass s uid) uid' req)"
  and "uid = UID1 ∧ uid' = UID2 ∨ uid = UID2 ∧ uid' = UID1"
  and "φ (Trans s a outOK s')"
  and "f (Trans s a outOK s') = FRVal u req"
  and "validValSeqFrom vl s'"
proof (cases u)
  case U1
    then have "step s (Cact (cFriendReq UID1 (pass s UID1) UID2 req)) =
                 (outOK, createFriendReq s UID1 (pass s UID1) UID2 req)"
          and "¬friends12 (createFriendReq s UID1 (pass s UID1) UID2 req)"
      using IDs vVS reach_friendIDs_symmetric[OF rs] by (auto simp: c_defs friends12_def)
    then show thesis using U1 vVS UID1_UID2 by (intro that[of _ _ UID1 UID2]) (auto simp: c_defs)
next
  case U2
    then have "step s (Cact (cFriendReq UID2 (pass s UID2) UID1 req)) =
                 (outOK, createFriendReq s UID2 (pass s UID2) UID1 req)"
          and "¬friends12 (createFriendReq s UID2 (pass s UID2) UID1 req)"
      using IDs vVS reach_friendIDs_symmetric[OF rs] by (auto simp: c_defs friends12_def)
    then show thesis using U2 vVS UID1_UID2 by (intro that[of _ _ UID2 UID1]) (auto simp: c_defs)
qed

(* helper *) lemma toggle_friends12_True:
assumes rs: "reach s"
    and IDs: "IDsOK s [UID1, UID2] [] [] []"
    and nf12: "¬friends12 s"
    and vVS: "validValSeqFrom (FVal True # vl) s"
obtains a uid uid' s'
where "step s a = (outOK, s')"
  and "a = Cact (cFriend uid (pass s uid) uid')"
  and "s' = createFriend s UID1 (pass s UID1) UID2"
  and "uid = UID1 ∧ uid' = UID2 ∨ uid = UID2 ∧ uid' = UID1"
  and "friends12 s'"
  and "eqButUID s s'"
  and "φ (Trans s a outOK s')"
  and "f (Trans s a outOK s') = FVal True"
  and "¬γ (Trans s a outOK s')"
  and "validValSeqFrom vl s'"
proof -
  from vVS have "UID1 ∈∈ pendingFReqs s UID2 ∨ UID2 ∈∈ pendingFReqs s UID1" by auto
  then show thesis proof
    assume pFR: "UID1 ∈∈ pendingFReqs s UID2"
    let ?a = "Cact (cFriend UID2 (pass s UID2) UID1)"
    let ?s' = "createFriend s UID1 (pass s UID1) UID2"
    let ?trn = "Trans s ?a outOK ?s'"
    have step: "step s ?a = (outOK, ?s')" using IDs pFR UID1_UID2
      unfolding createFriend_sym[of "s" "UID1" "pass s UID1" "UID2" "pass s UID2"]
      by (auto simp add: c_defs)
    moreover then have "φ ?trn" and "f ?trn = FVal True" and "friends12 ?s'"
                   and "UID1 ∉ set (pendingFReqs ?s' UID2)"
                   and "UID2 ∉ set (pendingFReqs ?s' UID1)"
      using reach_distinct_friends_reqs[OF rs] by (auto simp: c_defs friends12_def)
    moreover have "¬γ ?trn" using UID1_UID2_UIDs by auto
    ultimately show thesis using nf12 rs vVS
      by (intro that[of "?a" "?s'" UID2 UID1]) (auto intro: Cact_cFriend_step_eqButUID)
  next
    assume pFR: "UID2 ∈∈ pendingFReqs s UID1"
    let ?a = "Cact (cFriend UID1 (pass s UID1) UID2)"
    let ?s' = "createFriend s UID1 (pass s UID1) UID2"
    let ?trn = "Trans s ?a outOK ?s'"
    have step: "step s ?a = (outOK, ?s')" using IDs pFR UID1_UID2 by (auto simp add: c_defs)
    moreover then have "φ ?trn" and "f ?trn = FVal True" and "friends12 ?s'"
                   and "UID1 ∉ set (pendingFReqs ?s' UID2)"
                   and "UID2 ∉ set (pendingFReqs ?s' UID1)"
      using reach_distinct_friends_reqs[OF rs] by (auto simp: c_defs friends12_def)
    moreover have "¬γ ?trn" using UID1_UID2_UIDs by auto
    ultimately show thesis using nf12 rs vVS
      by (intro that[of "?a" "?s'" UID1 UID2]) (auto intro: Cact_cFriend_step_eqButUID)
  qed
qed

(* helper *) lemma toggle_friends12_False:
assumes rs: "reach s"
    and IDs: "IDsOK s [UID1, UID2] [] [] []"
    and f12: "friends12 s"
    and vVS: "validValSeqFrom (FVal False # vl) s"
obtains a s'
where "step s a = (outOK, s')"
  and "a = Dact (dFriend UID1 (pass s UID1) UID2)"
  and "s' = deleteFriend s UID1 (pass s UID1) UID2"
  and "¬friends12 s'"
  and "eqButUID s s'"
  and "φ (Trans s a outOK s')"
  and "f (Trans s a outOK s') = FVal False"
  and "¬γ (Trans s a outOK s')"
  and "validValSeqFrom vl s'"
proof -
  let ?a = "Dact (dFriend UID1 (pass s UID1) UID2)"
  let ?s' = "deleteFriend s UID1 (pass s UID1) UID2"
  let ?trn = "Trans s ?a outOK ?s'"
  have "UID1 ∉ set (pendingFReqs s UID2)" "UID2 ∉ set (pendingFReqs s UID1)"
    using f12 reach_distinct_friends_reqs[OF rs] unfolding friends12_def by auto
  then have step: "step s ?a = (outOK, ?s')"
        and "UID1 ∉ set (pendingFReqs ?s' UID2)" "UID2 ∉ set (pendingFReqs ?s' UID1)"
    using IDs f12 UID1_UID2 by (auto simp add: d_defs friends12_def)
  moreover then have "φ ?trn" and "f ?trn = FVal False" and "¬friends12 ?s'"
    using reach_friendIDs_symmetric[OF rs] by (auto simp: d_defs friends12_def)
  moreover have "¬γ ?trn" using UID1_UID2_UIDs by auto
  ultimately show thesis using f12 rs vVS
    by (intro that[of ?a ?s']) (auto intro: Dact_dFriend_step_eqButUID)
qed

lemma toggle_friends12:
assumes rs: "reach s"
    and IDs: "IDsOK s [UID1, UID2] [] [] []"
    and f12: "friends12 s ≠ fv"
    and vVS: "validValSeqFrom (FVal fv # vl) s"
obtains a s'
where "step s a = (outOK, s')"
  and "friends12 s' = fv"
  and "eqButUID s s'"
  and "φ (Trans s a outOK s')"
  and "f (Trans s a outOK s') = FVal fv"
  and "¬γ (Trans s a outOK s')"
  and "validValSeqFrom vl s'"
proof (cases "friends12 s")
  case True
    moreover then have "UID1 ∉ set (pendingFReqs s UID2)" "UID2 ∉ set (pendingFReqs s UID1)"
                   and "fv = False"
                   and vVS: "validValSeqFrom (FVal False # vl) s"
      using reach_distinct_friends_reqs[OF rs] vVS f12 unfolding friends12_def by auto
    moreover then have "UID1 ∉ set (pendingFReqs (deleteFriend s UID1 (pass s UID1) UID2) UID2)"
                       "UID2 ∉ set (pendingFReqs (deleteFriend s UID1 (pass s UID1) UID2) UID1)"
      by (auto simp: d_defs)
    ultimately show thesis using assms
      by (elim toggle_friends12_False, blast, blast, blast) (elim that, blast+)
next
  case False
    moreover then have "fv = True"
                   and vVS: "validValSeqFrom (FVal True # vl) s"
      using vVS f12 by auto
    moreover have "UID1 ∉ set (pendingFReqs (createFriend s UID1 (pass s UID1) UID2) UID2)"
                  "UID2 ∉ set (pendingFReqs (createFriend s UID1 (pass s UID1) UID2) UID1)"
      using reach_distinct_friends_reqs[OF rs] by (auto simp: c_defs)
    ultimately show thesis using assms
      by (elim toggle_friends12_True, blast, blast, blast) (elim that, blast+)
qed


(* helper *) lemma BO_cases:
assumes "BO vl vl1"
obtains (Nil) "vl = []" and "vl1 = []"
      | (FVal) fv vl' vl1' where "vl = FVal fv # vl'" and "vl1 = FVal fv # vl1'" and "BO vl' vl1'"
      | (OVal) vl' vl1' where "vl = OVal False # vl'" and "vl1 = OVal False # vl1'" and "BC vl' vl1'"
using assms proof (cases rule: BO.cases)
  case (BO_FVal fs) then show thesis by (cases fs) (auto intro: Nil FVal) next
  case (BO_BC vl'' vl1'' fs) then show thesis by (cases fs) (auto intro: FVal OVal)
qed

(* helper *) lemma BC_cases:
assumes "BC vl vl1"
obtains (Nil) "vl = []" and "vl1 = []"
      | (FVal) fv fs where "vl = FVal fv # map FVal fs" and "vl1 = []"
      | (FVal1) fv fs fs1 where "vl = map FVal fs" and "vl1 = FVal fv # map FVal fs1"
      | (BO_FVal) fv fv' fs vl' vl1' where "vl = FVal fv # map FVal fs @ FVal fv' # OVal True # vl'"
                                       and "vl1 = FVal fv' # OVal True # vl1'" and "BO vl' vl1'"
      | (BO_FVal1) fv fv' fs fs1 vl' vl1' where "vl = map FVal fs @ FVal fv' # OVal True # vl'"
                                       and "vl1 = FVal fv # map FVal fs1 @ FVal fv' # OVal True # vl1'"
                                       and "BO vl' vl1'"
      | (FVal_BO) fv vl' vl1' where "vl = FVal fv # OVal True # vl'"
                                and "vl1 = FVal fv # OVal True # vl1'" and "BO vl' vl1'"
      | (OVal) vl' vl1' where "vl = OVal True # vl'" and "vl1 = OVal True # vl1'" and "BO vl' vl1'"
using assms proof (cases rule: BC.cases)
  case (BC_FVal fs fs1)
    then show ?thesis proof (induction fs1)
      case Nil then show ?case by (induction fs) (auto intro: that(1,2)) next
      case (Cons fv fs1') then show ?case by (intro that(3)) auto
    qed
next
  case (BC_BO vl' vl1' fs fs1)
    then show ?thesis proof (cases fs1 rule: rev_cases)
      case Nil then show ?thesis using BC_BO by (intro that(7)) auto next
      case (snoc fs1' fv')
        moreover then obtain fs' where "fs = fs' ## fv'" using BC_BO
          by (induction fs rule: rev_induct) auto
        ultimately show ?thesis using BC_BO proof (induction fs1')
          case Nil
            then show ?thesis proof (induction fs')
              case Nil then show ?thesis by (intro that(6)) auto next
              case (Cons fv'' fs'') then show ?thesis by (intro that(4)) auto
            qed
        next
          case (Cons fv'' fs1'') then show ?thesis by (intro that(5)) auto
        qed
    qed
qed


definition Δ0 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ0 s vl s1 vl1 ≡
 s = s1 ∧ B vl vl1 ∧ open s ∧ (¬IDsOK s [UID1, UID2] [] [] [])"

definition Δ1 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ1 s vl s1 vl1 ≡
 eqButUID s s1 ∧ friendIDs s = friendIDs s1 ∧ open s ∧
 BO (filter (Not o isFRVal) vl) (filter (Not o isFRVal) vl1) ∧
 validValSeqFrom vl1 s1 ∧
 IDsOK s1 [UID1, UID2] [] [] []"

definition Δ2 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ2 s vl s1 vl1 ≡ (∃fs fs1.
 eqButUID s s1 ∧ ¬open s ∧
 validValSeqFrom vl1 s1 ∧
 filter (Not o isFRVal) vl  = map FVal fs  ∧
 filter (Not o isFRVal) vl1 = map FVal fs1)"

definition Δ3 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ3 s vl s1 vl1 ≡ (∃fs fs1 vlr vlr1.
 eqButUID s s1 ∧ ¬open s ∧ BO vlr vlr1 ∧
 validValSeqFrom vl1 s1 ∧
 (fs = [] ⟷ fs1 = []) ∧
 (fs ≠ [] ⟶ last fs = last fs1) ∧
 (fs = [] ⟶ friendIDs s = friendIDs s1) ∧
 filter (Not o isFRVal) vl  = map FVal fs  @ OVal True # vlr ∧
 filter (Not o isFRVal) vl1 = map FVal fs1 @ OVal True # vlr1)"


lemma Δ2_I:
assumes "eqButUID s s1" "¬open s"
        "validValSeqFrom vl1 s1"
        "filter (Not o isFRVal) vl  = map FVal fs"
        "filter (Not o isFRVal) vl1 = map FVal fs1"
shows "Δ2 s vl s1 vl1"
using assms unfolding Δ2_def by blast

lemma Δ3_I:
assumes "eqButUID s s1" "¬open s" "BO vlr vlr1"
        "validValSeqFrom vl1 s1"
        "fs = [] ⟷ fs1 = []" "fs ≠ [] ⟶ last fs = last fs1"
        "fs = [] ⟶ friendIDs s = friendIDs s1"
        "filter (Not o isFRVal) vl  = map FVal fs  @ OVal True # vlr"
        "filter (Not o isFRVal) vl1 = map FVal fs1 @ OVal True # vlr1"
shows "Δ3 s vl s1 vl1"
using assms unfolding Δ3_def by blast


lemma istate_Δ0:
assumes B: "B vl vl1"
shows "Δ0 istate vl istate vl1"
using assms unfolding Δ0_def istate_def B_def open_def openByA_def openByF_def friends12_def
by auto

lemma unwind_cont_Δ0: "unwind_cont Δ0 {Δ0,Δ1,Δ2,Δ3}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ0 s vl s1 vl1 ∨
                           Δ1 s vl s1 vl1 ∨
                           Δ2 s vl s1 vl1 ∨
                           Δ3 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Δ0: "Δ0 s vl s1 vl1"
  then have rs: "reach s" and ss1: "s1 = s" and B: "B vl vl1" and os: "open s"
        and IDs: "¬IDsOK s [UID1, UID2] [] [] []"
    using reachNT_reach unfolding Δ0_def by auto
  from IDs have "UID1 ∉ set (pendingFReqs s UID2)" and "¬friends12 s"
            and "UID2 ∉ set (pendingFReqs s UID1)"
    using reach_IDs_used_IDsOK[OF rs] unfolding friends12_def by auto
  with B have BO: "BO (filter (Not ∘ isFRVal) vl) (filter (Not ∘ isFRVal) vl1)"
          and vl_vl1: "vl = [] ⟶ vl1 = []"
          and vl_OVal: "vl ≠ [] ∧ hd vl = OVal False ⟶ vl1 ≠ [] ∧ hd vl1 = OVal False"
          and vVS: "validValSeqFrom vl1 s"
    unfolding B_def by (auto simp: istate_def friends12_def)
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof -
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof cases
        assume φ: "φ ?trn"
        then obtain uid p uid' p' where a: "a = Cact (cUser uid p uid' p')"
                                     "¬openByA s'" "¬openByF s'"
                                     "ou = outOK" "f ?trn = OVal False"
                                     "friends12 s' = friends12 s"
                                     "UID1 ∈∈ pendingFReqs s' UID2 ⟷ UID1 ∈∈ pendingFReqs s UID2"
                                     "UID2 ∈∈ pendingFReqs s' UID1 ⟷ UID2 ∈∈ pendingFReqs s UID1"
          using step rs IDs by (elim φE) (auto simp: openByA_def)
        with c φ have vl: "vl = OVal False # vl'" unfolding consume_def by auto
        with vl_OVal obtain vl1' where vl1: "vl1 = OVal False # vl1'" by (cases vl1) auto
        from BO vl vl1 have BC': "BC (filter (Not ∘ isFRVal) vl') (filter (Not ∘ isFRVal) vl1')"
          by (cases rule: BO_cases) auto
        then have "Δ2 s' vl' s' vl1' ∨ Δ3 s' vl' s' vl1'" using vVS a unfolding vl1
        proof (cases rule: BC.cases)
          case BC_FVal
            then show ?thesis using vVS a unfolding vl1
              by (intro disjI1 Δ2_I) (auto simp: open_def)
        next
          case BC_BO
            then show ?thesis using vVS a unfolding vl1
              by (intro disjI2 Δ3_I) (auto simp: open_def)
        qed
        then have ?match using step a φ unfolding ss1 vl1
          by (intro matchI[of s a ou s']) (auto simp: consume_def)
        then show ?thesis ..
      next
        assume nφ: "¬φ ?trn"
        then have s': "open s'" "friends12 s' = friends12 s"
                      "UID1 ∈∈ pendingFReqs s' UID2 ⟷ UID1 ∈∈ pendingFReqs s UID2"
                      "UID2 ∈∈ pendingFReqs s' UID1 ⟷ UID2 ∈∈ pendingFReqs s UID1"
          using os step_open_φ[OF step] step_friends12_φ[OF step] step_pendingFReqs_φ[OF step]
          by auto
        moreover have "vl' = vl" using nφ c by (auto simp: consume_def)
        ultimately have "Δ0 s' vl' s' vl1 ∨ Δ1 s' vl' s' vl1"
          using vVS B BO unfolding Δ0_def Δ1_def
          by (cases "IDsOK s' [UID1, UID2] [] [] []") auto
        then have ?match using step c nφ unfolding ss1
          by (intro matchI[of s a ou s']) (auto simp: consume_def)
        then show ?thesis ..
      qed
    qed
    then show ?thesis using vl_vl1 by auto
  qed
qed

lemma unwind_cont_Δ1: "unwind_cont Δ1 {Δ1,Δ2,Δ3}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ1 s vl s1 vl1 ∨
                           Δ2 s vl s1 vl1 ∨
                           Δ3 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Δ1: "Δ1 s vl s1 vl1"
  then have rs: "reach s" and ss1: "eqButUID s s1" and fIDs: "friendIDs s = friendIDs s1"
        and os: "open s" and BO: "BO (filter (Not o isFRVal) vl) (filter (Not o isFRVal) vl1)"
        and vVS1: "validValSeq vl1 (friends12 s1)
                                   (UID1 ∈∈ pendingFReqs s1 UID2)
                                   (UID2 ∈∈ pendingFReqs s1 UID1)" (is "?vVS vl1 s1")
        and IDs1: "IDsOK s1 [UID1, UID2] [] [] []"
    using reachNT_reach unfolding Δ1_def by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof cases
    assume "∃u req vl1'. vl1 = FRVal u req # vl1'"
    then obtain u req vl1' where vl1: "vl1 = FRVal u req # vl1'" by auto
    obtain a uid uid' s1' where step1: "step s1 a = (outOK, s1')" and "φ (Trans s1 a outOK s1')"
                            and a: "a = Cact (cFriendReq uid (pass s1 uid) uid' req)"
                            and uid: "uid = UID1 ∧ uid' = UID2 ∨ uid = UID2 ∧ uid' = UID1"
                            and "f (Trans s1 a outOK s1') = FRVal u req" and "?vVS vl1' s1'"
      using rs1 IDs1 vVS1 UID1_UID2_UIDs unfolding vl1 by (blast intro: produce_FRVal)
    moreover then have "¬γ (Trans s1 a outOK s1')" using UID1_UID2_UIDs by auto
    moreover have "eqButUID s1 s1'" using step1 a uid by (auto intro: Cact_cFriendReq_step_eqButUID)
    moreover have "friendIDs s1' = friendIDs s1" and "IDsOK s1' [UID1, UID2] [] [] []"
      using step1 a uid by (auto simp: c_defs)
    ultimately have "?iact" using ss1 fIDs os BO unfolding vl1
      by (intro iactionI[of s1 a "outOK" s1']) (auto simp: consume_def Δ1_def intro: eqButUID_trans)
    then show ?thesis ..
  next
    assume nFRVal1: "¬ (∃u req vl1'. vl1 = FRVal u req # vl1')"
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof cases
        assume φ: "φ ?trn"
        then have vl: "vl = f ?trn # vl'" using c by (auto simp: consume_def)
        from BO show ?thesis proof (cases "f ?trn")
          case (FVal fv)
            with BO obtain vl1' where vl1: "vl1 = f ?trn # vl1'"
              using BO_Nil_iff[OF BO] FVal vl nFRVal1
              by (cases rule: BO_cases; cases vl1; cases "hd vl1") auto
            with BO have BO': "BO (filter (Not o isFRVal) vl') (filter (Not o isFRVal) vl1')"
              using FVal vl by (cases rule: BO_cases) auto
            from fIDs have f12: "friends12 s = friends12 s1" unfolding friends12_def by auto
            have ?match using φ step rs FVal proof (cases rule: φE)
              case (Friend uid p uid')
                then have IDs1: "IDsOK s1 [UID1, UID2] [] [] []"
                  using ss1 unfolding eqButUID_def by auto
                let ?s1' = "createFriend s1 UID1 (pass s1 UID1) UID2"
                have s': "s' = createFriend s UID1 p UID2"
                  using Friend step by (auto simp: createFriend_sym)
                have ss': "eqButUID s s'" using rs step Friend
                  by (auto intro: Cact_cFriend_step_eqButUID)
                moreover then have os': "open s'" using os eqButUID_open_eq by auto
                moreover obtain a1 uid1 uid1' p1
                where "step s1 a1 = (outOK, ?s1')" "friends12 ?s1'"
                      "a1 = Cact (cFriend uid1 p1 uid1')"
                      "uid1 = UID1 ∧ uid1' = UID2 ∨ uid1 = UID2 ∧ uid1' = UID1"
                      "φ (Trans s1 a1 outOK ?s1')"
                      "f (Trans s1 a1 outOK ?s1') = FVal True"
                      "eqButUID s1 ?s1'" "?vVS vl1' ?s1'"
                  using rs1 IDs1 Friend vVS1 unfolding vl1 f12 Friend(3)
                  by (elim toggle_friends12_True) blast+
                moreover then have "IDsOK ?s1' [UID1, UID2] [] [] []" by (auto simp: c_defs)
                moreover have "friendIDs s' = friendIDs ?s1'"
                  using Friend(6) f12 unfolding s'
                  by (intro eqButUID_createFriend12_friendIDs_eq[OF ss1 rs rs1]) auto
                ultimately show ?match using ss1 BO' Friend UID1_UID2_UIDs unfolding vl1 Δ1_def
                  by (intro matchI[of s1 a1 "outOK" ?s1'])
                     (auto simp: consume_def intro: eqButUID_trans eqButUID_sym)
            next
              case (Unfriend uid p uid')
                then have IDs1: "IDsOK s1 [UID1, UID2] [] [] []"
                  using ss1 unfolding eqButUID_def by auto
                let ?s1' = "deleteFriend s1 UID1 (pass s1 UID1) UID2"
                have s': "s' = deleteFriend s UID1 p UID2"
                  using Unfriend step by (auto simp: deleteFriend_sym)
                have ss': "eqButUID s s'" using rs step Unfriend
                  by (auto intro: Dact_dFriend_step_eqButUID)
                moreover then have os': "open s'" using os eqButUID_open_eq by auto
                moreover obtain a1 uid1 uid1' p1
                where "step s1 a1 = (outOK, ?s1')" "¬friends12 ?s1'"
                      "a1 = Dact (dFriend uid1 p1 uid1')"
                      "uid1 = UID1 ∧ uid1' = UID2 ∨ uid1 = UID2 ∧ uid1' = UID1"
                      "φ (Trans s1 a1 outOK ?s1')"
                      "f (Trans s1 a1 outOK ?s1') = FVal False"
                      "eqButUID s1 ?s1'" "?vVS vl1' ?s1'"
                  using rs1 IDs1 Unfriend vVS1 unfolding vl1 f12 Unfriend(3)
                  by (elim toggle_friends12_False) blast+
                moreover have "friendIDs s' = friendIDs ?s1'" "IDsOK ?s1' [UID1, UID2] [] [] []"
                  using fIDs IDs1 unfolding s' by (auto simp: d_defs)
                ultimately show ?match using ss1 BO' Unfriend UID1_UID2_UIDs unfolding vl1 Δ1_def
                  by (intro matchI[of s1 a1 "outOK" ?s1'])
                     (auto simp: consume_def intro: eqButUID_trans eqButUID_sym)
            qed auto
            then show ?thesis ..
        next
          case (OVal ov)
            with BO obtain vl1' where vl1': "vl1 = OVal False # vl1'"
              using BO_Nil_iff[OF BO] OVal vl nFRVal1
              by (cases rule: BO_cases; cases vl1; cases "hd vl1") auto
            with BO have BC': "BC (filter (Not o isFRVal) vl') (filter (Not o isFRVal) vl1')"
              using OVal vl by (cases rule: BO_cases) auto
            from BO vl OVal have "f ?trn = OVal False" by (cases rule: BO_cases) auto
            with φ step rs have ?match proof (cases rule: φE)
              case (CloseF uid p uid')
                let ?s1' = "deleteFriend s1 uid p uid'"
                let ?trn1 = "Trans s1 a outOK ?s1'"
                have s': "s' = deleteFriend s uid p uid'" using CloseF step by auto
                have step1: "step s1 a = (outOK, ?s1')"
                 and pFR1': "pendingFReqs ?s1' = pendingFReqs s1"
                  using CloseF step ss1 fIDs unfolding eqButUID_def by (auto simp: d_defs)
                have s's1': "eqButUID s' ?s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
                moreover have os': "¬open s'" using CloseF os unfolding open_def by auto
                moreover have fIDs': "friendIDs s' = friendIDs ?s1'"
                  using fIDs unfolding s' by (auto simp: d_defs)
                moreover have f12s1: "friends12 s1 = friends12 ?s1'"
                  using CloseF(2) UID1_UID2_UIDs unfolding friends12_def d_defs by auto
                from BC' have "Δ2 s' vl' ?s1' vl1' ∨ Δ3 s' vl' ?s1' vl1'"
                proof (cases rule: BC.cases)
                  case (BC_FVal fs fs1)
                    then show ?thesis using vVS1 os' fIDs' f12s1 s's1' pFR1'
                      unfolding Δ2_def vl1' by auto
                next
                  case (BC_BO vlr vlr1 fs fs1)
                    then have "Δ3 s' vl' ?s1' vl1'" using s's1' os' vVS1 f12s1 fIDs' pFR1'
                      unfolding vl1' by (intro Δ3_I[of _ _ _ _ _ fs fs1]) auto
                    then show ?thesis ..
                qed
                moreover have "open s1" "¬open ?s1'"
                  using ss1 os s's1' os' by (auto simp: eqButUID_open_eq)
                moreover then have "φ ?trn1" unfolding CloseF by auto
                ultimately show ?match using step1 vl1' CloseF UID1_UID2 UID1_UID2_UIDs
                  by (intro matchI[of s1 a outOK ?s1' vl1 vl1']) (auto simp: consume_def)
            next
              case (CloseA uid p uid' p')
                let ?s1' = "createUser s1 uid p uid' p'"
                let ?trn1 = "Trans s1 a outOK ?s1'"
                have s': "s' = createUser s uid p uid' p'" using CloseA step by auto
                have step1: "step s1 a = (outOK, ?s1')"
                 and pFR1': "pendingFReqs ?s1' = pendingFReqs s1"
                  using CloseA step ss1 unfolding eqButUID_def by (auto simp: c_defs)
                have s's1': "eqButUID s' ?s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
                moreover have os': "¬open s'" using CloseA os unfolding open_def by auto
                moreover have fIDs': "friendIDs s' = friendIDs ?s1'"
                  using fIDs unfolding s' by (auto simp: c_defs)
                moreover have f12s1: "friends12 s1 = friends12 ?s1'"
                  unfolding friends12_def by (auto simp: c_defs)
                from BC' have "Δ2 s' vl' ?s1' vl1' ∨ Δ3 s' vl' ?s1' vl1'"
                proof (cases rule: BC.cases)
                  case (BC_FVal fs fs1)
                    then show ?thesis using vVS1 os' fIDs' f12s1 s's1' pFR1'
                      unfolding Δ2_def vl1' by auto
                next
                  case (BC_BO vlr vlr1 fs fs1)
                    then have "Δ3 s' vl' ?s1' vl1'" using s's1' os' vVS1 f12s1 fIDs' pFR1'
                      unfolding vl1' by (intro Δ3_I[of _ _ _ _ _ fs fs1]) auto
                    then show ?thesis ..
                qed
                moreover have "open s1" "¬open ?s1'"
                  using ss1 os s's1' os' by (auto simp: eqButUID_open_eq)
                moreover then have "φ ?trn1" unfolding CloseA by auto
                ultimately show ?match using step1 vl1' CloseA UID1_UID2 UID1_UID2_UIDs
                  by (intro matchI[of s1 a outOK ?s1' vl1 vl1']) (auto simp: consume_def)
            qed auto
            then show ?thesis ..
        next
          case (FRVal u req)
            obtain p
            where a: "(a = Cact (cFriendReq UID1 p UID2 req) ∧ UID1 ∈∈ pendingFReqs s' UID2 ∧
                       UID1 ∉ set (pendingFReqs s UID2) ∧
                       (UID2 ∈∈ pendingFReqs s' UID1 ⟷ UID2 ∈∈ pendingFReqs s UID1)) ∨
                      (a = Cact (cFriendReq UID2 p UID1 req) ∧ UID2 ∈∈ pendingFReqs s' UID1 ∧
                       UID2 ∉ set (pendingFReqs s UID1) ∧
                       (UID1 ∈∈ pendingFReqs s' UID2 ⟷ UID1 ∈∈ pendingFReqs s UID2))"
                     "ou = outOK" "¬friends12 s" "¬friends12 s'" "open s' = open s"
              using φ step rs FRVal by (cases rule: φE) fastforce+
            then have fIDs': "friendIDs s' = friendIDs s" using step by (auto simp: c_defs)
            have "eqButUID s s'" using a step
              by (auto intro: Cact_cFriendReq_step_eqButUID)
            then have "Δ1 s' vl' s1 vl1"
              unfolding Δ1_def using ss1 fIDs' fIDs os a(5) vVS1 IDs1 BO vl FRVal
              by (auto intro: eqButUID_trans eqButUID_sym)
            moreover from φ step rs a have "¬γ (Trans s a ou s')"
              using UID1_UID2_UIDs by (cases rule: φE) auto
            ultimately have ?ignore by (intro ignoreI) auto
            then show ?thesis ..
        qed
      next
        assume nφ: "¬φ ?trn"
        then have os': "open s = open s'" and f12s': "friends12 s = friends12 s'"
          using step_open_φ[OF step] step_friends12_φ[OF step] by auto
        have vl': "vl' = vl" using nφ c by (auto simp: consume_def)
        show ?thesis proof (cases "∀req. a ≠ Cact (cFriend UID1 (pass s UID1) UID2) ∧
                                         a ≠ Cact (cFriend UID2 (pass s UID2) UID1) ∧
                                         a ≠ Cact (cFriendReq UID2 (pass s UID2) UID1 req) ∧
                                         a ≠ Cact (cFriendReq UID1 (pass s UID1) UID2 req) ∧
                                         a ≠ Dact (dFriend UID1 (pass s UID1) UID2) ∧
                                         a ≠ Dact (dFriend UID2 (pass s UID2) UID1)")
          case True
            obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by (cases "step s1 a") auto
            let ?trn1 = "Trans s1 a ou1 s1'"
            have fIDs': "friendIDs s' = friendIDs s1'" using True
              by (intro eqButUID_step_friendIDs_eq[OF ss1 rs rs1 step step1 _ fIDs]) auto
            from True nφ have nφ': "¬φ ?trn1" using eqButUID_step_φ[OF ss1 rs rs1 step step1] by auto
            then have f12s1': "friends12 s1 = friends12 s1'"
                  and pFRs': "UID1 ∈∈ pendingFReqs s1 UID2 ⟷ UID1 ∈∈ pendingFReqs s1' UID2"
                             "UID2 ∈∈ pendingFReqs s1 UID1 ⟷ UID2 ∈∈ pendingFReqs s1' UID1"
              using step_friends12_φ[OF step1] step_pendingFReqs_φ[OF step1]
              by auto
            have "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
            then have "Δ1 s' vl' s1' vl1" using os fIDs' vVS1 BO IDsOK_mono[OF step1 IDs1]
              unfolding Δ1_def os' f12s1' pFRs' vl' by auto
            then have ?match
              using step1 nφ' fIDs eqButUID_step_γ_out[OF ss1 step step1]
              by (intro matchI[of s1 a ou1 s1' vl1 vl1]) (auto simp: consume_def)
            then show "?match ∨ ?ignore" ..
        next
          case False
            with nφ have "ou ≠ outOK" by auto
            then have "s' = s" using step False by auto
            then have ?ignore using Δ1 False UID1_UID2_UIDs unfolding vl' by (intro ignoreI) auto
            then show "?match ∨ ?ignore" ..
        qed
      qed
    qed
    moreover have "vl = [] ⟶ vl1 = []" proof
      assume "vl = []"
      with BO have "filter (Not ∘ isFRVal) vl1 = []" using BO_Nil_iff[OF BO] by auto
      with nFRVal1 show "vl1 = []" by (cases vl1; cases "hd vl1") auto
    qed
    ultimately show ?thesis by auto
  qed
qed

lemma unwind_cont_Δ2: "unwind_cont Δ2 {Δ2, Δ1}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ2 s vl s1 vl1 ∨ Δ1 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and 2: "Δ2 s vl s1 vl1"
  from rsT have rs: "reach s" by (intro reachNT_reach)
  from 2 obtain fs fs1
  where ss1: "eqButUID s s1" and os: "¬open s"
    and vVS1: "validValSeqFrom vl1 s1"
    and fs:  "filter (Not o isFRVal) vl =  map FVal fs"
    and fs1: "filter (Not o isFRVal) vl1 = map FVal fs1"
    unfolding Δ2_def by auto
  from os have IDs: "IDsOK s [UID1, UID2] [] [] []" unfolding open_defs by auto
  then have IDs1: "IDsOK s1 [UID1, UID2] [] [] []" using ss1 unfolding eqButUID_def by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof cases
    assume vl1: "vl1 = []"
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof cases
        assume φ: "φ ?trn"
        with c have vl: "vl = f ?trn # vl'" by (auto simp: consume_def)
        with fs have ?ignore proof (cases "f ?trn")
          case (FRVal u req)
            obtain p
            where a: "(a = Cact (cFriendReq UID1 p UID2 req) ∧ UID1 ∈∈ pendingFReqs s' UID2 ∧
                       UID1 ∉ set (pendingFReqs s UID2) ∧
                       (UID2 ∈∈ pendingFReqs s' UID1 ⟷ UID2 ∈∈ pendingFReqs s UID1)) ∨
                      (a = Cact (cFriendReq UID2 p UID1 req) ∧ UID2 ∈∈ pendingFReqs s' UID1 ∧
                       UID2 ∉ set (pendingFReqs s UID1) ∧
                       (UID1 ∈∈ pendingFReqs s' UID2 ⟷ UID1 ∈∈ pendingFReqs s UID2))"
                     "ou = outOK" "¬friends12 s" "¬friends12 s'" "open s' = open s"
              using φ step rs FRVal by (cases rule: φE) fastforce+
            then have fIDs': "friendIDs s' = friendIDs s" using step by (auto simp: c_defs)
            have "eqButUID s s'" using a step
              by (auto intro: Cact_cFriendReq_step_eqButUID)
            then have "Δ2 s' vl' s1 vl1"
              unfolding Δ2_def using ss1 os a(5) vVS1 vl fs fs1
              by (auto intro: eqButUID_trans eqButUID_sym)
            moreover from φ step rs a have "¬γ (Trans s a ou s')"
              using UID1_UID2_UIDs by (cases rule: φE) auto
            ultimately show ?ignore by (intro ignoreI) auto
        next
          case (FVal fv)
            with fs vl obtain fs' where fs': "fs = fv # fs'" by (cases fs) auto
            from φ step rs FVal have ss': "eqButUID s s'"
              by (elim φE) (auto intro: Cact_cFriend_step_eqButUID Dact_dFriend_step_eqButUID)
            then have "¬open s'" using os by (auto simp: eqButUID_open_eq)
            moreover have "eqButUID s' s1" using ss1 ss' by (auto intro: eqButUID_sym eqButUID_trans)
            ultimately have "Δ2 s' vl' s1 vl1"
              using vVS1 fs' fs unfolding Δ2_def vl vl1 FVal by auto
            moreover have "¬γ ?trn" using φ step rs FVal UID1_UID2_UIDs by (elim φE) auto
            ultimately show ?ignore by (intro ignoreI) auto
        qed auto
        then show ?thesis ..
      next
        assume nφ: "¬φ ?trn"
        then have os': "open s = open s'" and f12s': "friends12 s = friends12 s'"
          using step_open_φ[OF step] step_friends12_φ[OF step] by auto
        have vl': "vl' = vl" using nφ c by (auto simp: consume_def)
        show ?thesis proof (cases "∀req. a ≠ Cact (cFriend UID1 (pass s UID1) UID2) ∧
                                         a ≠ Cact (cFriend UID2 (pass s UID2) UID1) ∧
                                         a ≠ Cact (cFriendReq UID2 (pass s UID2) UID1 req) ∧
                                         a ≠ Cact (cFriendReq UID1 (pass s UID1) UID2 req) ∧
                                         a ≠ Dact (dFriend UID1 (pass s UID1) UID2) ∧
                                         a ≠ Dact (dFriend UID2 (pass s UID2) UID1)")
          case True
            obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by (cases "step s1 a") auto
            let ?trn1 = "Trans s1 a ou1 s1'"
            from True nφ have nφ': "¬φ ?trn1"
              using eqButUID_step_φ[OF ss1 rs rs1 step step1] by auto
            then have f12s1': "friends12 s1 = friends12 s1'"
                  and pFRs': "UID1 ∈∈ pendingFReqs s1 UID2 ⟷ UID1 ∈∈ pendingFReqs s1' UID2"
                             "UID2 ∈∈ pendingFReqs s1 UID1 ⟷ UID2 ∈∈ pendingFReqs s1' UID1"
              using step_friends12_φ[OF step1] step_pendingFReqs_φ[OF step1]
              by auto
            have "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
            then have "Δ2 s' vl' s1' vl1" using os vVS1 fs fs1
              unfolding Δ2_def os' f12s1' pFRs' vl' by auto
            then have ?match
              using step1 nφ' os eqButUID_step_γ_out[OF ss1 step step1]
              by (intro matchI[of s1 a ou1 s1' vl1 vl1]) (auto simp: consume_def)
            then show "?match ∨ ?ignore" ..
        next
          case False
            with nφ have "ou ≠ outOK" by auto
            then have "s' = s" using step False by auto
            then have ?ignore using 2 False UID1_UID2_UIDs unfolding vl' by (intro ignoreI) auto
            then show "?match ∨ ?ignore" ..
        qed
      qed
    qed
    then show ?thesis using vl1 by auto
  next
    assume "vl1 ≠ []"
    then obtain v vl1' where vl1: "vl1 = v # vl1'" by (cases vl1) auto
    with fs1 have ?iact proof (cases v)
      case (FRVal u req)
        obtain a uid uid' s1' where step1: "step s1 a = (outOK, s1')" and "φ (Trans s1 a outOK s1')"
                                and a: "a = Cact (cFriendReq uid (pass s1 uid) uid' req)"
                                and uid: "uid = UID1 ∧ uid' = UID2 ∨ uid = UID2 ∧ uid' = UID1"
                                and "f (Trans s1 a outOK s1') = FRVal u req"
                                and vVS1': "validValSeqFrom vl1' s1'"
          using rs1 IDs1 vVS1 UID1_UID2_UIDs unfolding vl1 FRVal by (blast intro: produce_FRVal)
        moreover then have "¬γ (Trans s1 a outOK s1')" using UID1_UID2_UIDs by auto
        moreover have "eqButUID s1 s1'" using step1 a uid
          by (auto intro: Cact_cFriendReq_step_eqButUID)
        moreover then have "Δ2 s vl s1' vl1'" using ss1 os vVS1' fs fs1 unfolding vl1 FRVal
          by (intro Δ2_I[of s s1' vl1' vl fs fs1]) (auto intro: eqButUID_trans)
        ultimately show "?iact" using ss1 os unfolding vl1 FRVal
          by (intro iactionI[of s1 a "outOK" s1']) (auto simp: consume_def intro: eqButUID_trans)
    next
      case (FVal fv)
        then obtain fs1' where fs1': "fs1 = fv # fs1'"
          using vl1 fs1 by (cases fs1) auto
        from FVal vVS1 vl1 have f12: "friends12 s1 ≠ fv"
                            and vVS1: "validValSeqFrom (FVal fv # vl1') s1" by auto
        then show ?iact using rs1 IDs1 vl1 FVal ss1 os fs fs1 fs1' vl1 FVal
          by (elim toggle_friends12[of s1 fv vl1'], blast, blast, blast)
             (intro iactionI[of s1 _ _ _ vl1 vl1'],
              auto simp: consume_def intro: Δ2_I[of s _ vl1' vl fs fs1'] eqButUID_trans)
    qed auto
    then show ?thesis ..
  qed
qed

(*
        then have os': "open s = open s'" and f12s': "friends12 s = friends12 s'"
          using step_open_φ[OF step] step_friends12_φ[OF step] by auto
        have vl': "vl' = vl" using nφ c by (auto simp: consume_def)
        show ?thesis proof (cases "a ≠ Cact (cFriend UID1 (pass s UID1) UID2) ∧
                                   a ≠ Cact (cFriend UID2 (pass s UID2) UID1) ∧
                                   a ≠ Dact (dFriend UID1 (pass s UID1) UID2) ∧
                                   a ≠ Dact (dFriend UID2 (pass s UID2) UID1)")
          case True
            obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by (cases "step s1 a") auto
            let ?trn1 = "Trans s1 a ou1 s1'"
            from True nφ have nφ': "¬φ ?trn1" using eqButUID_step_φ[OF ss1 rs rs1 step step1] by auto
            then have f12s1': "friends12 s1 = friends12 s1'"
              using step_friends12_φ[OF step1] by auto
            have "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
            then have "Δ1 s' vl' s1' vl1" using os aF1 vl vl1
              unfolding Δ1_def os' vl' f12s1' by auto
            then have ?match
              using step1 nφ' os eqButUID_step_γ_out[OF ss1 step step1]
              by (intro matchI[of s1 a ou1 s1' vl1 vl1]) (auto simp: consume_def)
            then show "?match ∨ ?ignore" ..
        next
          case False
            with nφ have "ou ≠ outOK" by auto
            then have "s' = s" using step False by auto
            then have ?ignore using 1 False UID1_UID2_UIDs unfolding vl' by (intro ignoreI) auto
            then show "?match ∨ ?ignore" ..
        qed
      qed
    qed
    then show ?thesis using fs1 unfolding vl1 by auto
  next
    assume "fs1 ≠ []"
    then obtain fs1' where fs1: "fs1 = (¬friends12 s1) # fs1'"
                       and aF1': "alternatingFriends (map FVal fs1') (¬friends12 s1)"
      using aF1 unfolding vl1 by (cases fs1) auto
    obtain al oul s1' where "sstep s1 al = (oul, s1')" "al ≠ []" "eqButUID s1 s1'"
                            "friends12 s1' = (¬friends12 s1)"
                            "O (traceOf s1 al) = []" "V (traceOf s1 al) = [FVal (¬friends12 s1)]"
      using rs1 IDs1
      by (cases "friends12 s1") (auto intro: toggle_friends12_True toggle_friends12_False)
    moreover then have "Δ1 s vl s1' (map FVal fs1')"
      using os aF1' vl ss1 unfolding Δ1_def by (auto intro: eqButUID_sym eqButUID_trans)
    ultimately have ?iact using vl1 unfolding fs1
      by (intro iactionI_ms[of s1 al oul s1'])
         (auto simp: consumeList_def O_Nil_never list_ex_iff_length_V)
    then show ?thesis ..
  qed
qed
*)

lemma unwind_cont_Δ3: "unwind_cont Δ3 {Δ3,Δ1}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ3 s vl s1 vl1 ∨ Δ1 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and 3: "Δ3 s vl s1 vl1"
  from rsT have rs: "reach s" by (intro reachNT_reach)
  obtain fs fs1 vlr vlr1
  where ss1: "eqButUID s s1" and os: "¬open s" and BO: "BO vlr vlr1"
    and vVS1: "validValSeqFrom vl1 s1"
    and fs:  "filter (Not o isFRVal) vl =  map FVal fs  @ OVal True # vlr"
    and fs1: "filter (Not o isFRVal) vl1 = map FVal fs1 @ OVal True # vlr1"
    and fs_fs1: "fs = [] ⟷ fs1 = []"
    and last_fs: "fs ≠ [] ⟶ last fs = last fs1"
    and fs_fIDs: "fs = [] ⟶ friendIDs s = friendIDs s1"
    using 3 unfolding Δ3_def by auto
  have BC: "BC (map FVal fs @ OVal True # vlr) (map FVal fs1 @ OVal True # vlr1)"
    using fs fs1 fs_fs1 last_fs BO by auto
  from os have IDs: "IDsOK s [UID1, UID2] [] [] []" unfolding open_defs by auto
  then have IDs1: "IDsOK s1 [UID1, UID2] [] [] []" using ss1 unfolding eqButUID_def by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof cases
    assume "∃u req vl1'. vl1 = FRVal u req # vl1'"
    then obtain u req vl1' where vl1: "vl1 = FRVal u req # vl1'" by auto
    obtain a uid uid' s1' where step1: "step s1 a = (outOK, s1')" and φ: "φ (Trans s1 a outOK s1')"
                            and a: "a = Cact (cFriendReq uid (pass s1 uid) uid' req)"
                            and uid: "uid = UID1 ∧ uid' = UID2 ∨ uid = UID2 ∧ uid' = UID1"
                            and f: "f (Trans s1 a outOK s1') = FRVal u req"
                            and "validValSeqFrom vl1' s1'"
      using rs1 IDs1 vVS1 UID1_UID2_UIDs unfolding vl1 by (blast intro: produce_FRVal)
    moreover have "eqButUID s1 s1'" using step1 a uid by (auto intro: Cact_cFriendReq_step_eqButUID)
    moreover have "friendIDs s1' = friendIDs s1" and "IDsOK s1' [UID1, UID2] [] [] []"
      using step1 a uid by (auto simp: c_defs)
    ultimately have "Δ3 s vl s1' vl1'" using ss1 os BO fs_fs1 last_fs fs_fIDs fs fs1 unfolding vl1
      by (intro Δ3_I[of _ _ vlr vlr1 vl1' fs fs1 vl])
         (auto simp: consume_def intro: eqButUID_trans)
    moreover have "¬γ (Trans s1 a outOK s1')" using a uid UID1_UID2_UIDs by auto
    ultimately have "?iact" using step1 φ f unfolding vl1
      by (intro iactionI[of s1 a "outOK" s1']) (auto simp: consume_def)
    then show ?thesis ..
  next
    assume nFRVal1: "¬(∃u req vl1'. vl1 = FRVal u req # vl1')"
    from BC show ?thesis proof (cases rule: BC_cases)
      case (BO_FVal fv fv' fs' vl'' vl1'')
        then have fs': "filter (Not o isFRVal) vl = map FVal (fv # fs' ## fv') @ OVal True # vl''"
              and fs1': "filter (Not o isFRVal) vl1 = FVal fv' # OVal True # vl1''"
          using fs fs1 by auto
        have ?react proof
          fix a :: act and ou :: out and s' :: state and vl'
          let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
          assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
          show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
          proof cases
            assume φ: "φ ?trn"
            with c have vl: "vl = f ?trn # vl'" by (auto simp: consume_def)
            with fs' have ?ignore proof (cases "f ?trn")
              case (FRVal u req)
                obtain p
                where a: "(a = Cact (cFriendReq UID1 p UID2 req) ∧ UID1 ∈∈ pendingFReqs s' UID2 ∧
                           UID1 ∉ set (pendingFReqs s UID2) ∧
                           (UID2 ∈∈ pendingFReqs s' UID1 ⟷ UID2 ∈∈ pendingFReqs s UID1)) ∨
                          (a = Cact (cFriendReq UID2 p UID1 req) ∧ UID2 ∈∈ pendingFReqs s' UID1 ∧
                           UID2 ∉ set (pendingFReqs s UID1) ∧
                           (UID1 ∈∈ pendingFReqs s' UID2 ⟷ UID1 ∈∈ pendingFReqs s UID2))"
                         "ou = outOK" "¬friends12 s" "¬friends12 s'" "open s' = open s"
                  using φ step rs FRVal by (cases rule: φE) fastforce+
                then have fIDs': "friendIDs s' = friendIDs s" using step by (auto simp: c_defs)
                have "eqButUID s s'" using a step
                  by (auto intro: Cact_cFriendReq_step_eqButUID)
                then have "Δ3 s' vl' s1 vl1"
                  using ss1 a os BO vVS1 fs_fs1 last_fs fs_fIDs fs fs1 fIDs' vl FRVal
                  by (intro Δ3_I[of s' s1 vlr vlr1 vl1 fs fs1 vl'])
                     (auto intro: eqButUID_trans eqButUID_sym)
                moreover from φ step rs a have "¬γ (Trans s a ou s')"
                  using UID1_UID2_UIDs by (cases rule: φE) auto
                ultimately show ?ignore by (intro ignoreI) auto
            next
              case (FVal fv'')
                with vl fs' have FVal: "f ?trn = FVal fv"
                             and vl': "filter (Not ∘ isFRVal) vl' = map FVal (fs' ## fv') @ OVal True # vl''"
                  by auto
                from φ step rs FVal have ss': "eqButUID s s'"
                  by (elim φE) (auto intro: Cact_cFriend_step_eqButUID Dact_dFriend_step_eqButUID)
                then have "¬open s'" using os by (auto simp: eqButUID_open_eq)
                moreover have "eqButUID s' s1" using ss1 ss' by (auto intro: eqButUID_sym eqButUID_trans)
                ultimately have "Δ3 s' vl' s1 vl1" using BO_FVal(3) vVS1 vl' fs1'
                  by (intro Δ3_I[of s' s1 vl'' vl1'' vl1 "fs' ## fv'" "[fv']" vl']) auto
                moreover have "¬γ ?trn" using φ step rs FVal UID1_UID2_UIDs by (elim φE) auto
                ultimately show ?ignore by (intro ignoreI) auto
            qed auto
            then show ?thesis ..
          next
            assume nφ: "¬φ ?trn"
            then have os': "open s = open s'" and f12s': "friends12 s = friends12 s'"
              using step_open_φ[OF step] step_friends12_φ[OF step] by auto
            have vl': "vl' = vl" using nφ c by (auto simp: consume_def)
            show ?thesis proof (cases "∀req. a ≠ Cact (cFriend UID1 (pass s UID1) UID2) ∧
                                             a ≠ Cact (cFriend UID2 (pass s UID2) UID1) ∧
                                             a ≠ Cact (cFriendReq UID2 (pass s UID2) UID1 req) ∧
                                             a ≠ Cact (cFriendReq UID1 (pass s UID1) UID2 req) ∧
                                             a ≠ Dact (dFriend UID1 (pass s UID1) UID2) ∧
                                             a ≠ Dact (dFriend UID2 (pass s UID2) UID1)")
              case True
                obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by (cases "step s1 a") auto
                let ?trn1 = "Trans s1 a ou1 s1'"
                from True nφ have nφ': "¬φ ?trn1"
                  using eqButUID_step_φ[OF ss1 rs rs1 step step1] by auto
                then have f12s1': "friends12 s1 = friends12 s1'"
                      and pFRs': "UID1 ∈∈ pendingFReqs s1 UID2 ⟷ UID1 ∈∈ pendingFReqs s1' UID2"
                                 "UID2 ∈∈ pendingFReqs s1 UID1 ⟷ UID2 ∈∈ pendingFReqs s1' UID1"
                  using step_friends12_φ[OF step1] step_pendingFReqs_φ[OF step1]
                  by auto
                have "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
                thm Δ3_I[of s' s1' vl'' vl1'' vl1 "fv # fs' ## fv'" "[fv']" vl']
                then have "Δ3 s' vl' s1' vl1" using os vVS1 fs' fs1' BO_FVal
                  unfolding os' f12s1' pFRs' vl'
                  by (intro Δ3_I[of s' s1' vl'' vl1'' vl1 "fv # fs' ## fv'" "[fv']" vl]) auto
                then have ?match
                  using step1 nφ' os eqButUID_step_γ_out[OF ss1 step step1]
                  by (intro matchI[of s1 a ou1 s1' vl1 vl1]) (auto simp: consume_def)
                then show "?match ∨ ?ignore" ..
            next
              case False
                with nφ have "ou ≠ outOK" by auto
                then have "s' = s" using step False by auto
                then have ?ignore using 3 False UID1_UID2_UIDs unfolding vl' by (intro ignoreI) auto
                then show "?match ∨ ?ignore" ..
            qed
          qed
        qed
        then show ?thesis using fs' by auto
    next
      case (BO_FVal1 fv fv' fs' fs1' vl'' vl1'')
        then have fs': "filter (Not o isFRVal) vl = map FVal (fs' ## fv') @ OVal True # vl''"
              and fs1': "filter (Not o isFRVal) vl1 = map FVal (fv # fs1' ## fv') @ OVal True # vl1''"
          using fs fs1 by auto
        with nFRVal1 obtain vl1'
        where vl1: "vl1 = FVal fv # vl1'"
          and vl1': "filter (Not o isFRVal) vl1' = map FVal (fs1' ## fv') @ OVal True # vl1''"
          by (cases vl1; cases "hd vl1") auto
        with vVS1 have f12: "friends12 s1 ≠ fv"
                   and vVS1: "validValSeqFrom (FVal fv # vl1') s1" by auto
        then have ?iact using rs1 IDs1 vl1 ss1 os BO_FVal1(3) fs' vl1'
          by (elim toggle_friends12[of s1 fv vl1'], blast, blast, blast)
             (intro iactionI[of s1 _ _ _ vl1 vl1'],
              auto simp: consume_def
                   intro: Δ3_I[of s _ vl'' vl1'' vl1' "fs' ## fv'" "fs1' ## fv'" vl]
                          eqButUID_trans)
        then show ?thesis ..
    next
      case (FVal_BO fv vl'' vl1'')
        then have fs': "filter (Not o isFRVal) vl = FVal fv # OVal True # vl''"
              and fs1': "filter (Not o isFRVal) vl1 = FVal fv # OVal True # vl1''"
          using fs fs1 by auto
        have ?react proof
          fix a :: act and ou :: out and s' :: state and vl'
          let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
          assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
          show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
          proof cases
            assume φ: "φ ?trn"
            with c have vl: "vl = f ?trn # vl'" by (auto simp: consume_def)
            with fs' show ?thesis proof (cases "f ?trn")
              case (FRVal u req)
                obtain p
                where a: "(a = Cact (cFriendReq UID1 p UID2 req) ∧ UID1 ∈∈ pendingFReqs s' UID2 ∧
                           UID1 ∉ set (pendingFReqs s UID2) ∧
                           (UID2 ∈∈ pendingFReqs s' UID1 ⟷ UID2 ∈∈ pendingFReqs s UID1)) ∨
                          (a = Cact (cFriendReq UID2 p UID1 req) ∧ UID2 ∈∈ pendingFReqs s' UID1 ∧
                           UID2 ∉ set (pendingFReqs s UID1) ∧
                           (UID1 ∈∈ pendingFReqs s' UID2 ⟷ UID1 ∈∈ pendingFReqs s UID2))"
                         "ou = outOK" "¬friends12 s" "¬friends12 s'" "open s' = open s"
                  using φ step rs FRVal by (cases rule: φE) fastforce+
                then have fIDs': "friendIDs s' = friendIDs s" using step by (auto simp: c_defs)
                have "eqButUID s s'" using a step
                  by (auto intro: Cact_cFriendReq_step_eqButUID)
                then have "Δ3 s' vl' s1 vl1"
                  using ss1 a os BO vVS1 fs_fs1 last_fs fs_fIDs fs fs1 fIDs' vl FRVal
                  by (intro Δ3_I[of s' s1 vlr vlr1 vl1 fs fs1 vl'])
                     (auto intro: eqButUID_trans eqButUID_sym)
                moreover from φ step rs a have "¬γ (Trans s a ou s')"
                  using UID1_UID2_UIDs by (cases rule: φE) auto
                ultimately have ?ignore by (intro ignoreI) auto
                then show ?thesis ..
            next
              case (FVal fv'')
                with vl fs' have FVal: "f ?trn = FVal fv"
                             and vl': "filter (Not ∘ isFRVal) vl' = OVal True # vl''"
                  by auto
                from fs1' nFRVal1 obtain vl1'
                where vl1: "vl1 = FVal fv # vl1'"
                  and vl1': "filter (Not ∘ isFRVal) vl1' = OVal True # vl1''"
                  by (cases vl1; cases "hd vl1") auto
                have ?match using φ step rs FVal proof (cases rule: φE)
                  case (Friend uid p uid')
                    then have IDs1: "IDsOK s1 [UID1, UID2] [] [] []"
                          and f12s1: "¬friends12 s1"
                          and fv: "fv = True"
                      using ss1 vVS1 FVal unfolding eqButUID_def vl1 by auto
                    let ?s1' = "createFriend s1 UID1 (pass s1 UID1) UID2"
                    have s': "s' = createFriend s UID1 p UID2"
                      using Friend step by (auto simp: createFriend_sym)
                    have ss': "eqButUID s s'" using rs step Friend
                      by (auto intro: Cact_cFriend_step_eqButUID)
                    moreover then have os': "¬open s'" using os eqButUID_open_eq by auto
                    moreover obtain a1 uid1 uid1' p1
                    where "step s1 a1 = (outOK, ?s1')" "friends12 ?s1'"
                          "a1 = Cact (cFriend uid1 p1 uid1')"
                          "uid1 = UID1 ∧ uid1' = UID2 ∨ uid1 = UID2 ∧ uid1' = UID1"
                          "φ (Trans s1 a1 outOK ?s1')"
                          "f (Trans s1 a1 outOK ?s1') = FVal True"
                          "eqButUID s1 ?s1'" "validValSeqFrom vl1' ?s1'"
                      using rs1 IDs1 Friend vVS1 f12s1 unfolding vl1 FVal
                      by (elim toggle_friends12_True; blast)
                    moreover then have "IDsOK ?s1' [UID1, UID2] [] [] []" by (auto simp: c_defs)
                    moreover have "friendIDs s' = friendIDs ?s1'"
                      using Friend(6) f12s1 unfolding s'
                      by (intro eqButUID_createFriend12_friendIDs_eq[OF ss1 rs rs1]) auto
                    ultimately show ?match
                      using ss1 FVal_BO Friend UID1_UID2_UIDs vl' vl1' unfolding vl1 fv
                      by (intro matchI[of s1 a1 "outOK" ?s1'])
                         (auto simp: consume_def intro: eqButUID_trans eqButUID_sym
                               intro!: Δ3_I[of s' ?s1' vl'' vl1'' vl1' "[]" "[]" vl'])
                next
                  case (Unfriend uid p uid')
                    then have IDs1: "IDsOK s1 [UID1, UID2] [] [] []"
                          and f12s1: "friends12 s1"
                          and fv: "fv = False"
                      using ss1 vVS1 FVal unfolding eqButUID_def vl1 by auto
                    let ?s1' = "deleteFriend s1 UID1 (pass s1 UID1) UID2"
                    have s': "s' = deleteFriend s UID1 p UID2"
                      using Unfriend step by (auto simp: deleteFriend_sym)
                    have ss': "eqButUID s s'" using rs step Unfriend
                      by (auto intro: Dact_dFriend_step_eqButUID)
                    moreover then have os': "¬open s'" using os eqButUID_open_eq by auto
                    moreover obtain a1 uid1 uid1' p1
                    where "step s1 a1 = (outOK, ?s1')" "¬friends12 ?s1'"
                          "a1 = Dact (dFriend uid1 p1 uid1')"
                          "uid1 = UID1 ∧ uid1' = UID2 ∨ uid1 = UID2 ∧ uid1' = UID1"
                          "φ (Trans s1 a1 outOK ?s1')"
                          "f (Trans s1 a1 outOK ?s1') = FVal False"
                          "eqButUID s1 ?s1'" "validValSeqFrom vl1' ?s1'"
                      using rs1 IDs1 Unfriend vVS1 f12s1 unfolding vl1 FVal
                      by (elim toggle_friends12_False; blast)
                    moreover then have "IDsOK ?s1' [UID1, UID2] [] [] []" by (auto simp: d_defs)
                    moreover have "friendIDs s' = friendIDs ?s1'"
                      using Unfriend(6) f12s1 unfolding s'
                      by (intro eqButUID_deleteFriend12_friendIDs_eq[OF ss1 rs rs1])
                    ultimately show ?match
                      using ss1 FVal_BO Unfriend UID1_UID2_UIDs vl' vl1' unfolding vl1 fv
                      by (intro matchI[of s1 a1 "outOK" ?s1'])
                         (auto simp: consume_def intro: eqButUID_trans eqButUID_sym
                               intro!: Δ3_I[of s' ?s1' vl'' vl1'' vl1' "[]" "[]" vl'])
                qed auto
                then show ?thesis ..
            qed auto
          next
            assume nφ: "¬φ ?trn"
            then have os': "open s = open s'" and f12s': "friends12 s = friends12 s'"
              using step_open_φ[OF step] step_friends12_φ[OF step] by auto
            have vl': "vl' = vl" using nφ c by (auto simp: consume_def)
            show ?thesis proof (cases "∀req. a ≠ Cact (cFriend UID1 (pass s UID1) UID2) ∧
                                             a ≠ Cact (cFriend UID2 (pass s UID2) UID1) ∧
                                             a ≠ Cact (cFriendReq UID2 (pass s UID2) UID1 req) ∧
                                             a ≠ Cact (cFriendReq UID1 (pass s UID1) UID2 req) ∧
                                             a ≠ Dact (dFriend UID1 (pass s UID1) UID2) ∧
                                             a ≠ Dact (dFriend UID2 (pass s UID2) UID1)")
              case True
                obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by (cases "step s1 a") auto
                let ?trn1 = "Trans s1 a ou1 s1'"
                from True nφ have nφ': "¬φ ?trn1"
                  using eqButUID_step_φ[OF ss1 rs rs1 step step1] by auto
                then have f12s1': "friends12 s1 = friends12 s1'"
                      and pFRs': "UID1 ∈∈ pendingFReqs s1 UID2 ⟷ UID1 ∈∈ pendingFReqs s1' UID2"
                                 "UID2 ∈∈ pendingFReqs s1 UID1 ⟷ UID2 ∈∈ pendingFReqs s1' UID1"
                  using step_friends12_φ[OF step1] step_pendingFReqs_φ[OF step1]
                  by auto
                have "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
                thm Δ3_I[of s' s1' vl'' vl1'' vl1 "[fv]" "[fv]" vl']
                then have "Δ3 s' vl' s1' vl1" using os vVS1 fs' fs1' FVal_BO
                  unfolding os' f12s1' pFRs' vl'
                  by (intro Δ3_I[of s' s1' vl'' vl1'' vl1 "[fv]" "[fv]" vl]) auto
                then have ?match
                  using step1 nφ' os eqButUID_step_γ_out[OF ss1 step step1]
                  by (intro matchI[of s1 a ou1 s1' vl1 vl1]) (auto simp: consume_def)
                then show "?match ∨ ?ignore" ..
            next
              case False
                with nφ have "ou ≠ outOK" by auto
                then have "s' = s" using step False by auto
                then have ?ignore using 3 False UID1_UID2_UIDs unfolding vl' by (intro ignoreI) auto
                then show "?match ∨ ?ignore" ..
            qed
          qed
        qed
        then show ?thesis using fs' by auto
    next
      case (OVal vl'' vl1'')
        then have fs': "filter (Not o isFRVal) vl = OVal True # vl''"
              and fs1': "filter (Not o isFRVal) vl1 = OVal True # vl1''"
              and BO'': "BO vl'' vl1''"
          using fs fs1 by auto
        from fs fs' have fs: "fs = []" by (cases fs) auto
        with fs_fIDs have fIDs: "friendIDs s = friendIDs s1" by auto
        have ?react proof
          fix a :: act and ou :: out and s' :: state and vl'
          let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
          assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
          show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
          proof cases
            assume φ: "φ ?trn"
            with c have vl: "vl = f ?trn # vl'" by (auto simp: consume_def)
            with fs' show ?thesis proof (cases "f ?trn")
              case (FRVal u req)
                obtain p
                where a: "(a = Cact (cFriendReq UID1 p UID2 req) ∧ UID1 ∈∈ pendingFReqs s' UID2 ∧
                           UID1 ∉ set (pendingFReqs s UID2) ∧
                           (UID2 ∈∈ pendingFReqs s' UID1 ⟷ UID2 ∈∈ pendingFReqs s UID1)) ∨
                          (a = Cact (cFriendReq UID2 p UID1 req) ∧ UID2 ∈∈ pendingFReqs s' UID1 ∧
                           UID2 ∉ set (pendingFReqs s UID1) ∧
                           (UID1 ∈∈ pendingFReqs s' UID2 ⟷ UID1 ∈∈ pendingFReqs s UID2))"
                         "ou = outOK" "¬friends12 s" "¬friends12 s'" "open s' = open s"
                  using φ step rs FRVal by (cases rule: φE) fastforce+
                then have fIDs': "friendIDs s' = friendIDs s" using step by (auto simp: c_defs)
                have "eqButUID s s'" using a step
                  by (auto intro: Cact_cFriendReq_step_eqButUID)
                then have "Δ3 s' vl' s1 vl1"
                  using ss1 a os OVal(3) vVS1 fs' fs1' fs fs_fs1 fIDs' fIDs unfolding vl FRVal
                  by (intro Δ3_I[of s' s1 vl'' vl1'' vl1 fs fs1 vl'])
                     (auto intro: eqButUID_trans eqButUID_sym)
                moreover from φ step rs a have "¬γ (Trans s a ou s')"
                  using UID1_UID2_UIDs by (cases rule: φE) auto
                ultimately have ?ignore by (intro ignoreI) auto
                then show ?thesis ..
            next
              case (OVal ov')
                with vl fs' have OVal: "f ?trn = OVal True"
                             and vl': "filter (Not ∘ isFRVal) vl' = vl''"
                  by auto
                from fs1' nFRVal1 obtain vl1'
                where vl1: "vl1 = OVal True # vl1'"
                  and vl1': "filter (Not ∘ isFRVal) vl1' = vl1''"
                  by (cases vl1; cases "hd vl1") auto
                have ?match using φ step rs OVal proof (cases rule: φE)
                  case (OpenF uid p uid')
                    let ?s1' = "createFriend s1 uid p uid'"
                    have s': "s' = createFriend s uid p uid'"
                      using OpenF step by auto
                    from OpenF(2) have uids: "uid ≠ UID1 ∧ uid ≠ UID2 ∧ uid' = UID1 ∨
                                        uid ≠ UID1 ∧ uid ≠ UID2 ∧ uid' = UID2 ∨
                                        uid' ≠ UID1 ∧ uid' ≠ UID2 ∧ uid = UID1 ∨
                                        uid' ≠ UID1 ∧ uid' ≠ UID2 ∧ uid = UID2"
                      using UID1_UID2_UIDs by auto
                    have "eqButUIDf (pendingFReqs s) (pendingFReqs s1)"
                      using ss1 unfolding eqButUID_def by auto
                    then have "uid' ∈∈ pendingFReqs s uid ⟷ uid' ∈∈ pendingFReqs s1 uid"
                      using OpenF by (intro eqButUIDf_not_UID') auto
                    then have step1: "step s1 a = (outOK, ?s1')"
                      using OpenF step ss1 fIDs unfolding eqButUID_def by (auto simp: c_defs)
                    have s's1': "eqButUID s' ?s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
                    moreover have os': "open s'" using OpenF unfolding open_def by auto
                    moreover have fIDs': "friendIDs s' = friendIDs ?s1'"
                      using fIDs unfolding s' by (auto simp: c_defs)
                    moreover have f12s1: "friends12 s1 = friends12 ?s1'"
                                  "UID1 ∈∈ pendingFReqs s1 UID2 ⟷ UID1 ∈∈ pendingFReqs ?s1' UID2"
                                  "UID2 ∈∈ pendingFReqs s1 UID1 ⟷ UID2 ∈∈ pendingFReqs ?s1' UID1"
                      using uids unfolding friends12_def c_defs by auto
                    moreover then have "validValSeqFrom vl1' ?s1'" using vVS1 unfolding vl1 by auto
                    ultimately have "Δ1 s' vl' ?s1' vl1'"
                      using BO'' IDsOK_mono[OF step1 IDs1] unfolding Δ1_def vl' vl1' by auto
                    moreover have "φ ?trn ⟷ φ (Trans s1 a outOK ?s1')"
                      using OpenF(1) uids by (intro eqButUID_step_φ[OF ss1 rs rs1 step step1]) auto
                    ultimately show ?match using step1 φ OpenF(1,3,4) unfolding vl1
                      by (intro matchI[of s1 a outOK ?s1' _ vl1']) (auto simp: consume_def)
                qed auto
                then show ?thesis ..
            qed auto
        next
          assume nφ: "¬φ ?trn"
            then have os': "open s = open s'" and f12s': "friends12 s = friends12 s'"
              using step_open_φ[OF step] step_friends12_φ[OF step] by auto
            have vl': "vl' = vl" using nφ c by (auto simp: consume_def)
            show ?thesis proof (cases "∀req. a ≠ Cact (cFriend UID1 (pass s UID1) UID2) ∧
                                             a ≠ Cact (cFriend UID2 (pass s UID2) UID1) ∧
                                             a ≠ Cact (cFriendReq UID2 (pass s UID2) UID1 req) ∧
                                             a ≠ Cact (cFriendReq UID1 (pass s UID1) UID2 req) ∧
                                             a ≠ Dact (dFriend UID1 (pass s UID1) UID2) ∧
                                             a ≠ Dact (dFriend UID2 (pass s UID2) UID1)")
              case True
                obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by (cases "step s1 a") auto
                let ?trn1 = "Trans s1 a ou1 s1'"
                from True nφ have nφ': "¬φ ?trn1"
                  using eqButUID_step_φ[OF ss1 rs rs1 step step1] by auto
                then have f12s1': "friends12 s1 = friends12 s1'"
                      and pFRs': "UID1 ∈∈ pendingFReqs s1 UID2 ⟷ UID1 ∈∈ pendingFReqs s1' UID2"
                                 "UID2 ∈∈ pendingFReqs s1 UID1 ⟷ UID2 ∈∈ pendingFReqs s1' UID1"
                  using step_friends12_φ[OF step1] step_pendingFReqs_φ[OF step1]
                  by auto
                have "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
                moreover have "friendIDs s' = friendIDs s1'"
                  using eqButUID_step_friendIDs_eq[OF ss1 rs rs1 step step1 _ fIDs] True
                  by auto
                ultimately have "Δ3 s' vl' s1' vl1" using os vVS1 fs' fs1' OVal
                  unfolding os' f12s1' pFRs' vl'
                  by (intro Δ3_I[of s' s1' vl'' vl1'' vl1 "[]" "[]" vl]) auto
                then have ?match
                  using step1 nφ' os eqButUID_step_γ_out[OF ss1 step step1]
                  by (intro matchI[of s1 a ou1 s1' vl1 vl1]) (auto simp: consume_def)
                then show "?match ∨ ?ignore" ..
            next
              case False
                with nφ have "ou ≠ outOK" by auto
                then have "s' = s" using step False by auto
                then have ?ignore using 3 False UID1_UID2_UIDs unfolding vl' by (intro ignoreI) auto
                then show "?match ∨ ?ignore" ..
            qed
          qed
        qed
        then show ?thesis using fs' by auto
    next
      case (FVal1 fv fs' fs1')
        from this(1) have "False" proof (induction fs' arbitrary: fs)
          case (Cons fv'' fs'')
            then obtain fs''' where "map FVal (fv'' # fs''') @ OVal True # vlr = map FVal (fv'' # fs'')"
              by (cases fs) auto
            with Cons.IH[of fs'''] show "False" by auto
        qed auto
        then show ?thesis ..
    next
      case (FVal) then show ?thesis by (induction fs) auto next
      case (Nil) then show ?thesis by auto
    qed
  qed
qed



definition Gr where
"Gr =
 {
 (Δ0, {Δ0,Δ1,Δ2,Δ3}),
 (Δ1, {Δ1,Δ2,Δ3}),
 (Δ2, {Δ2,Δ1}),
 (Δ3, {Δ3,Δ1})
 }"


theorem secure: secure
apply (rule unwind_decomp_secure_graph[of Gr Δ0])
unfolding Gr_def
apply (simp, smt insert_subset order_refl)
using
istate_Δ0 unwind_cont_Δ0 unwind_cont_Δ1 unwind_cont_Δ2 unwind_cont_Δ3
unfolding Gr_def by (auto intro: unwind_cont_mono)

end

end
ead>

Theory Friend_Request_Network

theory Friend_Request_Network
  imports
    "../API_Network"
    "Friend_Request"
    "BD_Security_Compositional.Composing_Security_Network"
begin

subsection ‹Confidentiality for the N-ary composition›

locale FriendRequestNetwork = Network + FriendNetworkObservationSetup +
fixes
  AID :: apiID
and
  UID1 :: userID
and
  UID2 :: userID
assumes
  UID1_UID2_UIDs: "{UID1,UID2} ∩ (UIDs AID) = {}"
and
  UID1_UID2: "UID1 ≠ UID2"
and
  AID_AIDs: "AID ∈ AIDs"
begin

sublocale Issuer: Friend "UIDs AID" UID1 UID2 using UID1_UID2_UIDs UID1_UID2 by unfold_locales

abbreviation φ :: "apiID ⇒ (state, act, out) trans ⇒ bool"
where "φ aid trn ≡ (Issuer.φ trn ∧ aid = AID)"

abbreviation f :: "apiID ⇒ (state, act, out) trans ⇒ Friend.value"
where "f aid trn ≡ Friend.f UID1 UID2 trn"

abbreviation T :: "apiID ⇒ (state, act, out) trans ⇒ bool"
where "T aid trn ≡ False"

abbreviation B :: "apiID ⇒ Friend.value list ⇒ Friend.value list ⇒ bool"
where "B aid vl vl1 ≡ (if aid = AID then Issuer.B vl vl1 else (vl = [] ∧ vl1 = []))"

abbreviation "comOfV aid vl ≡ Internal"
abbreviation "tgtNodeOfV aid vl ≡ undefined"
abbreviation "syncV aid1 vl1 aid2 vl2 ≡ False"

lemma [simp]: "validTrans aid trn ⟹ lreach aid (srcOf trn) ⟹ φ aid trn ⟹ comOf aid trn = Internal"
by (cases trn) (auto elim: Issuer.φE)

sublocale Net: BD_Security_TS_Network_getTgtV
where istate = "λ_. istate" and validTrans = validTrans and srcOf = "λ_. srcOf" and tgtOf = "λ_. tgtOf"
  and nodes = AIDs and comOf = comOf (*and srcNodeOf = srcNodeOf*) and tgtNodeOf = tgtNodeOf
  and sync = sync and φ = φ and f = f and γ = γ and g = g and T = T and B = B
  and comOfV = comOfV and tgtNodeOfV = tgtNodeOfV and syncV = syncV
  and comOfO = comOfO and tgtNodeOfO = tgtNodeOfO and syncO = syncO (*and cmpO = cmpO*)
  and source = AID and getTgtV = id
proof (unfold_locales, goal_cases)
  case (1 aid trn) then show ?case by auto next
  case (2 aid trn) then show ?case by auto next
  case (3 aid trn) then show ?case by (cases trn) auto next
  case (4 aid trn) then show ?case by (cases "(aid,trn)" rule: tgtNodeOf.cases) auto next
  case (5 aid1 trn1 aid2 trn2) then show ?case by auto next
  case (6 aid1 trn1 aid2 trn2) then show ?case by (cases trn1; cases trn2; auto) next
  case (7 aid1 trn1 aid2 trn2) then show ?case by auto next
  case (8 aid1 trn1 aid2 trn2) then show ?case by (cases trn1; cases trn2; auto) next
  case (9 aid trn) then show ?case by (cases "(aid,trn)" rule: tgtNodeOf.cases) (auto simp: FriendObservationSetup.γ.simps) next
  case (10 aid trn) then show ?case by auto
qed auto

sublocale BD_Security_TS_Network_Preserve_Source_Security_getTgtV
where istate = "λ_. istate" and validTrans = validTrans and srcOf = "λ_. srcOf" and tgtOf = "λ_. tgtOf"
  and nodes = AIDs and comOf = comOf and tgtNodeOf = tgtNodeOf
  and sync = sync and φ = φ and f = f and γ = γ and g = g and T = T and B = B
  and comOfV = comOfV and tgtNodeOfV = tgtNodeOfV and syncV = syncV
  and comOfO = comOfO and tgtNodeOfO = tgtNodeOfO and syncO = syncO (*and cmpO = cmpO*)
  and source = AID and getTgtV = id
using AID_AIDs Issuer.secure
by unfold_locales auto

theorem secure: "secure"
proof (intro preserve_source_secure ballI)
  fix aid
  assume "aid ∈ AIDs - {AID}"
  then show "Net.lsecure aid" by (intro Abstract_BD_Security.B_id_secure) (auto simp: B_id_def)
qed

end

end

Theory Friend_Request_All

theory Friend_Request_All
imports Friend_Request_Network
begin


end

Theory Outer_Friend_Intro

theory Outer_Friend_Intro
  imports "../Safety_Properties"
begin

section ‹Remote (outer) friendship status confidentiality›

text ‹
We verify the following property, which is specific to CosMeDis,
in that it does not have a CoSMed counterpart:
Given a coalition consisting of groups of users ‹UIDs j› from multiple nodes ‹j›
and a user ‹UID› at some node ‹i› not in these groups,

the coalition may learn about the ∗‹occurrence› of remote friendship actions of ‹UID›
(because network traffic is assumed to be observable),

but they learn nothing about the ∗‹content› (who was added or deleted as a friend)
of remote friendship actions between ‹UID› and remote users who are not in the coalition

beyond what everybody knows, namely that, with respect to each other user ‹uid'›,
those actions form an alternating sequence of friending and unfriending,

unless a user in ‹UIDs i› becomes a local friend of ‹UID›.

\ \\
Similarly to the other properties, this property is proved using the
system compositionality and transport theorems for BD security.

Note that, unlike inner friendship, outer friendship is not necessarily symmetric.
It is always established from a user of a server to a user of a client, the former giving
the latter unilateral access to his friend-only posts. These unilateral friendship permissions
are stored on the client.

When proving the single-node BD security properties, the bound refers to
outer friendship-status changes issued by the user ‹UID›
concerning friending or unfriending some user ‹UID'› located at a node ‹j›
different from ‹i›. Such changes occur as communicating actions between
the ``secret issuer'' node ‹i› and the ``secret receiver'' nodes ‹j›.
›

end
dy>

Theory Outer_Friend

theory Outer_Friend
  imports Outer_Friend_Intro
begin


type_synonym obs = "act * out"

text ‹The observers ‹UIDs j› are an arbitrary, but fixed sets of users at each node ‹j› of the
network, and the secret is the friendship information of user ‹UID› at node ‹AID›.›

locale OuterFriend =
fixes UIDs :: "apiID ⇒ userID set"
and AID :: "apiID"
and UID :: "userID"
assumes UID_UIDs: "UID ∉ UIDs AID"
and emptyUserID_not_UIDs: "⋀aid. emptyUserID ∉ UIDs aid"

datatype "value" =
  isFrVal: FrVal apiID userID bool ― ‹updates to the friendship status of UID›
| isOVal: OVal bool ― ‹a change in the ``openness" status of the UID friendship info›

end
tup

Theory Outer_Friend_Issuer_Observation_Setup

theory Outer_Friend_Issuer_Observation_Setup
  imports "../Outer_Friend"
begin

subsection ‹Issuer node›

subsubsection ‹Observation setup›

text ‹We now consider the network node ‹AID›, at which the user ‹UID› is registered, whose remote
   friends are to be kept confidential. ›
locale OuterFriendIssuer = OuterFriend
begin

fun γ :: "(state,act,out) trans ⇒ bool" where
"γ (Trans _ a ou _) ⟷ (∃ uid. userOfA a = Some uid ∧ uid ∈ UIDs AID) ∨
                        (∃ca. a = COMact ca ∧ ou ≠ outErr)"

text ‹Purging communicating actions: password information is removed, the user IDs of friends
   added or deleted by ‹UID› are removed, and the information whether ‹UID› added or deleted
   a friend is removed ›

fun comPurge :: "comActt ⇒ comActt" where
 "comPurge (comSendServerReq uID p aID reqInfo) = comSendServerReq uID emptyPass aID reqInfo"
|"comPurge (comReceiveClientReq aID reqInfo) = comReceiveClientReq aID reqInfo"
|"comPurge (comConnectClient uID p aID sp) = comConnectClient uID emptyPass aID sp"
|"comPurge (comConnectServer aID sp) = comConnectServer aID sp"
|"comPurge (comReceivePost aID sp nID nt uID v) = comReceivePost aID sp nID nt uID v"
|"comPurge (comSendPost uID p aID nID) = comSendPost uID emptyPass aID nID"
|"comPurge (comSendCreateOFriend uID p aID uID') =
    (if uID = UID ∧ uID' ∉ UIDs aID
     then comSendCreateOFriend uID emptyPass aID emptyUserID
     else comSendCreateOFriend uID emptyPass aID uID')"
|"comPurge (comReceiveCreateOFriend aID cp uID uID') = comReceiveCreateOFriend aID cp uID uID'"
|"comPurge (comSendDeleteOFriend uID p aID uID') =
    (if uID = UID ∧ uID' ∉ UIDs aID
     then comSendCreateOFriend uID emptyPass aID emptyUserID
     else comSendDeleteOFriend uID emptyPass aID uID')"
|"comPurge (comReceiveDeleteOFriend aID cp uID uID') = comReceiveDeleteOFriend aID cp uID uID'"

lemma comPurge_simps:
  "comPurge ca = comSendServerReq uID p aID reqInfo ⟷ (∃p'. ca = comSendServerReq uID p' aID reqInfo ∧ p = emptyPass)"
  "comPurge ca = comReceiveClientReq aID reqInfo ⟷ ca = comReceiveClientReq aID reqInfo"
  "comPurge ca = comConnectClient uID p aID sp ⟷ (∃p'. ca = comConnectClient uID p' aID sp ∧ p = emptyPass)"
  "comPurge ca = comConnectServer aID sp ⟷ ca = comConnectServer aID sp"
  "comPurge ca = comReceivePost aID sp nID nt uID v ⟷ ca = comReceivePost aID sp nID nt uID v"
  "comPurge ca = comSendPost uID p aID nID ⟷ (∃p'. ca = comSendPost uID p' aID nID ∧ p = emptyPass)"
  "comPurge ca = comSendCreateOFriend uID p aID uID'
⟷ (∃p' uid''. (ca = comSendCreateOFriend uID p' aID uid'' ∨ ca = comSendDeleteOFriend uID p' aID uid'') ∧ uID = UID ∧ uid'' ∉ UIDs aID ∧ uID' = emptyUserID ∧ p = emptyPass)
    ∨ (∃p'. ca = comSendCreateOFriend uID p' aID uID' ∧ ¬(uID = UID ∧ uID' ∉ UIDs aID) ∧ p = emptyPass)"
  "comPurge ca = comReceiveCreateOFriend aID cp uID uID' ⟷ ca = comReceiveCreateOFriend aID cp uID uID'"
  "comPurge ca = comSendDeleteOFriend uID p aID uID' ⟷ (∃p'. ca = comSendDeleteOFriend uID p' aID uID' ∧ ¬(uID = UID ∧ uID' ∉ UIDs aID) ∧ p = emptyPass)"
  "comPurge ca = comReceiveDeleteOFriend aID cp uID uID' ⟷ ca = comReceiveDeleteOFriend aID cp uID uID'"
by (cases ca; auto)+

text ‹Purging outputs: the user IDs of friends added or deleted
   by ‹UID› are removed from outer friend creation and deletion outputs.›
fun outPurge :: "out ⇒ out" where
 "outPurge (O_sendCreateOFriend (aID, sp, uID, uID')) =
  (if uID = UID ∧ uID' ∉ UIDs aID
   then O_sendCreateOFriend (aID, sp, uID, emptyUserID)
   else O_sendCreateOFriend (aID, sp, uID, uID'))"
|"outPurge (O_sendDeleteOFriend (aID, sp, uID, uID')) =
  (if uID = UID ∧ uID' ∉ UIDs aID
   then O_sendCreateOFriend (aID, sp, uID, emptyUserID)
   else O_sendDeleteOFriend (aID, sp, uID, uID'))"
|"outPurge ou = ou"

lemma outPurge_simps[simp]:
  "outPurge ou = outErr ⟷ ou = outErr"
  "outPurge ou = outOK ⟷ ou = outOK"
  "outPurge ou = O_sendServerReq ossr ⟷ ou = O_sendServerReq ossr"
  "outPurge ou = O_connectClient occ ⟷ ou = O_connectClient occ"
  "outPurge ou = O_sendPost osn ⟷ ou = O_sendPost osn"
  "outPurge ou = O_sendCreateOFriend (aID, sp, uID, uID')
 ⟷ (∃uid''. (ou = O_sendCreateOFriend (aID, sp, uID, uid'') ∨ ou = O_sendDeleteOFriend (aID, sp, uID, uid'')) ∧ uID = UID ∧ uid'' ∉ UIDs aID ∧ uID' = emptyUserID)
     ∨ (ou = O_sendCreateOFriend (aID, sp, uID, uID') ∧ ¬(uID = UID ∧ uID' ∉ UIDs aID))"
  "outPurge ou = O_sendDeleteOFriend (aID, sp, uID, uID')
 ⟷ (ou = O_sendDeleteOFriend (aID, sp, uID, uID') ∧ ¬(uID = UID ∧ uID' ∉ UIDs aID))"
by (cases ou; cases "uID = UID"; auto)+

fun g :: "(state,act,out)trans ⇒ obs" where
 "g (Trans _ (COMact ca) ou _) = (COMact (comPurge ca), outPurge ou)"
|"g (Trans _ a ou _) = (a,ou)"

lemma g_simps:
  "g (Trans s a ou s') = (COMact (comSendServerReq uID p aID reqInfo), O_sendServerReq ossr)
⟷ (∃p'. a = COMact (comSendServerReq uID p' aID reqInfo) ∧ p = emptyPass ∧ ou = O_sendServerReq ossr)"
  "g (Trans s a ou s') = (COMact (comReceiveClientReq aID reqInfo), outOK)
⟷ a = COMact (comReceiveClientReq aID reqInfo) ∧ ou = outOK"
  "g (Trans s a ou s') = (COMact (comConnectClient uID p aID sp), O_connectClient occ)
⟷ (∃p'. a = COMact (comConnectClient uID p' aID sp) ∧ p = emptyPass ∧ ou = O_connectClient occ)"
  "g (Trans s a ou s') = (COMact (comConnectServer aID sp), outOK)
⟷ a = COMact (comConnectServer aID sp) ∧ ou = outOK"
  "g (Trans s a ou s') = (COMact (comReceivePost aID sp nID nt uID v), outOK)
⟷ a = COMact (comReceivePost aID sp nID nt uID v) ∧ ou = outOK"
  "g (Trans s a ou s') = (COMact (comSendPost uID p aID nID), O_sendPost osn)
⟷ (∃p'. a = COMact (comSendPost uID p' aID nID) ∧ p = emptyPass ∧ ou = O_sendPost osn)"
  "g (Trans s a ou s') = (COMact (comSendCreateOFriend uID p aID uID'), O_sendCreateOFriend (aid, sp, uid, uid'))
⟷ ((∃p' uid''. (a = COMact (comSendCreateOFriend uID p' aID uid'') ∨ a = COMact (comSendDeleteOFriend uID p' aID uid'')) ∧ uID = UID ∧ uid'' ∉ UIDs aID ∧ uID' = emptyUserID ∧ p = emptyPass)
    ∨ (∃p'. a = COMact (comSendCreateOFriend uID p' aID uID') ∧ ¬(uID = UID ∧ uID' ∉ UIDs aID) ∧ p = emptyPass))
    ∧ ((∃uid''. (ou = O_sendCreateOFriend (aid, sp, uid, uid'') ∨ ou = O_sendDeleteOFriend (aid, sp, uid, uid'')) ∧ uid = UID ∧ uid'' ∉ UIDs aid ∧ uid' = emptyUserID)
     ∨ (ou = O_sendCreateOFriend (aid, sp, uid, uid') ∧ ¬(uid = UID ∧ uid' ∉ UIDs aid)))"
  "g (Trans s a ou s') = (COMact (comReceiveCreateOFriend aID cp uID uID'), outOK)
⟷ a = COMact (comReceiveCreateOFriend aID cp uID uID') ∧ ou = outOK"
  "g (Trans s a ou s') = (COMact (comSendDeleteOFriend uID p aID uID'), O_sendDeleteOFriend (aid, sp, uid, uid'))
⟷ (∃p'. a = COMact (comSendDeleteOFriend uID p' aID uID') ∧ ¬(uID = UID ∧ uID' ∉ UIDs aID) ∧ p = emptyPass)
    ∧ (ou = O_sendDeleteOFriend (aid, sp, uid, uid') ∧ ¬(uid = UID ∧ uid' ∉ UIDs aid))"
  "g (Trans s a ou s') = (COMact (comReceiveDeleteOFriend aID cp uID uID'), outOK)
⟷ a = COMact (comReceiveDeleteOFriend aID cp uID uID') ∧ ou = outOK"
  by (cases a; auto simp: comPurge_simps)+

end


end
guishability

Theory Outer_Friend_Issuer_State_Indistinguishability

(* The state equivalence used for the unwinding proofs for the friendship confidentiality
   properties *)
theory Outer_Friend_Issuer_State_Indistinguishability
  imports Outer_Friend_Issuer_Observation_Setup
begin

subsubsection ‹Unwinding helper definitions and lemmas›

context OuterFriendIssuer
begin

fun filterUIDs :: "(apiID × userID) list ⇒ (apiID × userID) list" where
"filterUIDs auidl = filter (λauid. (snd auid) ∈ UIDs (fst auid)) auidl"

fun removeUIDs :: "(apiID × userID) list ⇒ (apiID × userID) list" where
"removeUIDs auidl = filter (λauid. (snd auid) ∉ UIDs (fst auid)) auidl"

(* The notion of two (apiID × userID) lists being equal on observers: *)
fun eqButUIDs :: "(apiID × userID) list ⇒ (apiID × userID) list ⇒ bool" where
"eqButUIDs uidl uidl1 = (filterUIDs uidl = filterUIDs uidl1)"

lemma eqButUIDs_eq[simp,intro!]: "eqButUIDs uidl uidl"
by auto

lemma eqButUIDs_sym:
assumes "eqButUIDs uidl uidl1"
shows "eqButUIDs uidl1 uidl"
using assms by auto

lemma eqButUIDs_trans:
assumes "eqButUIDs uidl uidl1" and "eqButUIDs uidl1 uidl2"
shows "eqButUIDs uidl uidl2"
using assms by auto

lemma eqButUIDs_remove1_cong:
assumes "eqButUIDs uidl uidl1"
shows "eqButUIDs (remove1 auid uidl) (remove1 auid uidl1)"
using assms by (auto simp: filter_remove1)

lemma eqButUIDs_snoc_cong:
assumes "eqButUIDs uidl uidl1"
(*and "uid' ∈∈ uidl ⟷ uid' ∈∈ uidl1"*)
shows "eqButUIDs (uidl ## auid') (uidl1 ## auid')"
using assms by auto


(* The notion of two functions each taking a userID being equal everywhere but on UID,
   where they are eqButUIDs. *)
definition eqButUIDf where
"eqButUIDf frds frds1 ≡
  eqButUIDs (frds UID) (frds1 UID)
∧ (∀uid. uid ≠ UID ⟶ frds uid = frds1 uid)"

lemmas eqButUIDf_intro = eqButUIDf_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eqButUIDf_eeq[simp,intro!]: "eqButUIDf frds frds"
unfolding eqButUIDf_def by auto

lemma eqButUIDf_sym:
assumes "eqButUIDf frds frds1" shows "eqButUIDf frds1 frds"
using assms unfolding eqButUIDf_def
by auto

lemma eqButUIDf_trans:
assumes "eqButUIDf frds frds1" and "eqButUIDf frds1 frds2"
shows "eqButUIDf frds frds2"
using assms unfolding eqButUIDf_def by auto

lemma eqButUIDf_cong:
assumes "eqButUIDf frds frds1"
and "uid ≠ UID ⟹ uu = uu1"
and "uid = UID ⟹ eqButUIDs uu uu1"
shows "eqButUIDf (frds (uid := uu)) (frds1(uid := uu1))"
using assms unfolding eqButUIDf_def by auto

lemma eqButUIDf_not_UID:
"⟦eqButUIDf frds frds1; uid ≠ UID⟧ ⟹ frds uid = frds1 uid"
unfolding eqButUIDf_def by (auto split: if_splits)

(* The notion of two states being equal everywhere but on the friendship requests or status of users UID1 and UID2: *)
definition eqButUID :: "state ⇒ state ⇒ bool" where
"eqButUID s s1 ≡
 admin s = admin s1 ∧

 pendingUReqs s = pendingUReqs s1 ∧ userReq s = userReq s1 ∧
 userIDs s = userIDs s1 ∧ user s = user s1 ∧ pass s = pass s1 ∧

 pendingFReqs s = pendingFReqs s1 ∧
 friendReq s = friendReq s1 ∧
 friendIDs s = friendIDs s1 ∧

 postIDs s = postIDs s1 ∧ admin s = admin s1 ∧
 post s = post s1 ∧ vis s = vis s1 ∧
 owner s = owner s1 ∧

 pendingSApiReqs s = pendingSApiReqs s1 ∧ sApiReq s = sApiReq s1 ∧
 serverApiIDs s = serverApiIDs s1 ∧ serverPass s = serverPass s1 ∧
 outerPostIDs s = outerPostIDs s1 ∧ outerPost s = outerPost s1 ∧ outerVis s = outerVis s1 ∧
 outerOwner s = outerOwner s1 ∧
 eqButUIDf (sentOuterFriendIDs s) (sentOuterFriendIDs s1) ∧
 recvOuterFriendIDs s = recvOuterFriendIDs s1 ∧

 pendingCApiReqs s = pendingCApiReqs s1 ∧ cApiReq s = cApiReq s1 ∧
 clientApiIDs s = clientApiIDs s1 ∧ clientPass s = clientPass s1 ∧
 sharedWith s = sharedWith s1"

lemmas eqButUID_intro = eqButUID_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eqButUID_refl[simp,intro!]: "eqButUID s s"
unfolding eqButUID_def by auto

lemma eqButUID_sym[sym]:
assumes "eqButUID s s1" shows "eqButUID s1 s"
using assms eqButUIDf_sym unfolding eqButUID_def by auto

lemma eqButUID_trans[trans]:
assumes "eqButUID s s1" and "eqButUID s1 s2" shows "eqButUID s s2"
using assms eqButUIDf_trans unfolding eqButUID_def by metis

(* Implications from eqButUID, including w.r.t. auxiliary operations: *)
lemma eqButUID_stateSelectors:
assumes "eqButUID s s1"
shows "admin s = admin s1"
"pendingUReqs s = pendingUReqs s1" "userReq s = userReq s1"
"userIDs s = userIDs s1" "user s = user s1" "pass s = pass s1"
"pendingFReqs s = pendingFReqs s1"
"friendReq s = friendReq s1"
"friendIDs s = friendIDs s1"

"postIDs s = postIDs s1"
"post s = post s1" "vis s = vis s1"
"owner s = owner s1"

"pendingSApiReqs s = pendingSApiReqs s1" "sApiReq s = sApiReq s1"
"serverApiIDs s = serverApiIDs s1" "serverPass s = serverPass s1"
"outerPostIDs s = outerPostIDs s1" "outerPost s = outerPost s1" "outerVis s = outerVis s1"
"outerOwner s = outerOwner s1"
"eqButUIDf (sentOuterFriendIDs s) (sentOuterFriendIDs s1)"
"recvOuterFriendIDs s = recvOuterFriendIDs s1"

"pendingCApiReqs s = pendingCApiReqs s1" "cApiReq s = cApiReq s1"
"clientApiIDs s = clientApiIDs s1" "clientPass s = clientPass s1"
"sharedWith s = sharedWith s1"

"IDsOK s = IDsOK s1"
using assms unfolding eqButUID_def IDsOK_def[abs_def] by auto

lemmas eqButUID_eqButUIDf = eqButUID_stateSelectors(22)

lemma eqButUID_eqButUIDs:
"eqButUID s s1 ⟹ eqButUIDs (sentOuterFriendIDs s UID) (sentOuterFriendIDs s1 UID)"
unfolding eqButUID_def eqButUIDf_def by auto

lemma eqButUID_not_UID:
"eqButUID s s1 ⟹ uid ≠ UID ⟹ sentOuterFriendIDs s uid = sentOuterFriendIDs s1 uid"
unfolding eqButUID_def eqButUIDf_def by auto

lemma eqButUID_sentOuterFriends_UIDs:
assumes "eqButUID s s1"
and "uid' ∈ UIDs aid"
shows "(aid, uid') ∈∈ sentOuterFriendIDs s UID ⟷ (aid, uid') ∈∈ sentOuterFriendIDs s1 UID"
proof -
  have "(aid, uid') ∈∈ filterUIDs (sentOuterFriendIDs s UID)
    ⟷ (aid, uid') ∈∈ filterUIDs (sentOuterFriendIDs s1 UID)"
    using assms unfolding eqButUID_def eqButUIDf_def by auto
  then show ?thesis using assms by auto
qed

lemma eqButUID_sentOuterFriendIDs_cong:
assumes "eqButUID s s1"
and "uid' ∉ UIDs aid"
shows "eqButUID (s⦇sentOuterFriendIDs := (sentOuterFriendIDs s)(UID := sentOuterFriendIDs s UID ## (aid, uid'))⦈) s1"
and "eqButUID s (s1⦇sentOuterFriendIDs := (sentOuterFriendIDs s1)(UID := sentOuterFriendIDs s1 UID ## (aid, uid'))⦈)"
and "eqButUID s (s1⦇sentOuterFriendIDs := (sentOuterFriendIDs s1)(UID := remove1 (aid, uid') (sentOuterFriendIDs s1 UID))⦈)"
and "eqButUID (s⦇sentOuterFriendIDs := (sentOuterFriendIDs s)(UID := remove1 (aid, uid') (sentOuterFriendIDs s UID))⦈) s1"
using assms unfolding eqButUID_def eqButUIDf_def by (auto simp: filter_remove1)

lemma eqButUID_cong:
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇admin := uu1⦈) (s1 ⦇admin := uu2⦈)"

"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇pendingUReqs := uu1⦈) (s1 ⦇pendingUReqs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇userReq := uu1⦈) (s1 ⦇userReq := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇userIDs := uu1⦈) (s1 ⦇userIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇user := uu1⦈) (s1 ⦇user := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇pass := uu1⦈) (s1 ⦇pass := uu2⦈)"

"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇postIDs := uu1⦈) (s1 ⦇postIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇owner := uu1⦈) (s1 ⦇owner := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇post := uu1⦈) (s1 ⦇post := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇vis := uu1⦈) (s1 ⦇vis := uu2⦈)"

"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇pendingFReqs := uu1⦈) (s1 ⦇pendingFReqs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇friendReq := uu1⦈) (s1 ⦇friendReq := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇friendIDs := uu1⦈) (s1 ⦇friendIDs := uu2⦈)"

"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇pendingSApiReqs := uu1⦈) (s1 ⦇pendingSApiReqs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇sApiReq := uu1⦈) (s1 ⦇sApiReq := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇serverApiIDs := uu1⦈) (s1 ⦇serverApiIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇serverPass := uu1⦈) (s1 ⦇serverPass := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇outerPostIDs := uu1⦈) (s1 ⦇outerPostIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇outerPost := uu1⦈) (s1 ⦇outerPost := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇outerVis := uu1⦈) (s1 ⦇outerVis := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇outerOwner := uu1⦈) (s1 ⦇outerOwner := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ eqButUIDf uu1 uu2 ⟹ eqButUID (s ⦇sentOuterFriendIDs := uu1⦈) (s1 ⦇sentOuterFriendIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇recvOuterFriendIDs := uu1⦈) (s1 ⦇recvOuterFriendIDs := uu2⦈)"

"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇pendingCApiReqs := uu1⦈) (s1 ⦇pendingCApiReqs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇cApiReq := uu1⦈) (s1 ⦇cApiReq := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇clientApiIDs := uu1⦈) (s1 ⦇clientApiIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇clientPass := uu1⦈) (s1 ⦇clientPass := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇sharedWith := uu1⦈) (s1 ⦇sharedWith:= uu2⦈)"
unfolding eqButUID_def by auto


lemma distinct_remove1_idem: "distinct xs ⟹ remove1 y (remove1 y xs) = remove1 y xs"
by (induction xs) (auto simp add: remove1_idem)

(* major *) lemma eqButUID_step:
assumes ss1: "eqButUID s s1"
and step: "step s a = (ou,s')"
and step1: "step s1 a = (ou1,s1')"
and rs: "reach s"
and rs1: "reach s1"
shows "eqButUID s' s1'"
proof -
  note simps = eqButUID_stateSelectors s_defs c_defs d_defs u_defs r_defs l_defs com_defs
               eqButUID_sentOuterFriends_UIDs eqButUID_not_UID
  from assms show ?thesis proof (cases a)
    case (Sact sa) with assms show ?thesis by (cases sa) (auto simp add: simps intro!: eqButUID_cong)
  next
    case (Cact ca) with assms show ?thesis by (cases ca) (auto simp add: simps intro!: eqButUID_cong)
  next
    case (Uact ua) with assms show ?thesis by (cases ua) (auto simp add: simps intro!: eqButUID_cong)
  next
    case (Ract ra) with assms show ?thesis by (cases ra) (auto simp add: simps intro!: eqButUID_cong)
  next
    case (Lact la) with assms show ?thesis by (cases la) (auto simp add: simps intro!: eqButUID_cong)
  next
    case (COMact ca)
      with assms show ?thesis proof (cases ca)
        case (comSendCreateOFriend uid p aid uid')
          then show ?thesis
            using COMact assms eqButUID_eqButUIDf[OF ss1] eqButUID_eqButUIDs[OF ss1]
            by (cases "uid = UID"; cases "uid' ∈ UIDs aid")
               (auto simp: simps intro!: eqButUID_cong eqButUIDf_cong intro: eqButUID_sentOuterFriendIDs_cong)
      next
        case (comSendDeleteOFriend uid p aid uid')
          then show ?thesis
            using COMact assms eqButUID_eqButUIDf[OF ss1] eqButUID_eqButUIDs[OF ss1]
            by (cases "uid = UID"; cases "uid' ∈ UIDs aid")
               (auto simp: simps filter_remove1 intro!: eqButUID_cong eqButUIDf_cong intro: eqButUID_sentOuterFriendIDs_cong)
      qed (auto simp: simps intro!: eqButUID_cong)
  next
    case (Dact da) with assms show ?thesis by (cases da) (auto simp add: simps intro!: eqButUID_cong)
  qed
qed

end

end
e>

Theory Outer_Friend_Issuer_Openness

theory Outer_Friend_Issuer_Openness
  imports Outer_Friend_Issuer_State_Indistinguishability
begin

subsubsection ‹Dynamic declassification trigger›

context OuterFriendIssuer
begin

text ‹The dynamic declassification trigger condition holds, i.e.~the access window to the
confidential information is open, while an observer is a local friend of the user ‹UID›.›

definition "open" :: "state ⇒ bool"
where "open s ≡ ∃uid ∈ UIDs AID. uid ∈∈ friendIDs s UID"

lemma open_step_cases:
assumes "open s ≠ open s'"
and "step s a = (ou, s')"
obtains
  (OpenF) uid p uid' where "a = Cact (cFriend uid p uid')" "ou = outOK" "p = pass s uid"
                           "uid ∈ UIDs AID ∧ uid' = UID ∨ uid = UID ∧ uid' ∈ UIDs AID"
                           "open s'" "¬open s"
| (CloseF) uid p uid' where "a = Dact (dFriend uid p uid')" "ou = outOK" "p = pass s uid"
                            "uid ∈ UIDs AID ∧ uid' = UID ∨ uid = UID ∧ uid' ∈ UIDs AID"
                            "open s" "¬open s'"
using assms proof (cases a)
  case (Uact ua) then show ?thesis using assms by (cases ua) (auto simp: u_defs open_def) next
  case (COMact ca) then show ?thesis using assms by (cases ca) (auto simp: com_defs open_def) next
  case (Sact sa)
    then show ?thesis using assms by (cases sa) (auto simp: s_defs open_def)
next
  case (Cact ca)
    then show ?thesis using assms proof (cases ca)
      case (cFriend uid p uid')
        then show ?thesis using Cact assms by (intro OpenF) (auto simp: c_defs open_def)
    qed (auto simp: c_defs open_def)
next
  case (Dact da)
    then show ?thesis using assms proof (cases da)
      case (dFriend uid p uid')
        then show ?thesis using Dact assms by (intro CloseF) (auto simp: d_defs open_def)
    qed
qed auto

lemma COMact_open:
assumes "step s a = (ou, s')"
and "a = COMact ca"
shows "open s = open s'"
by (rule ccontr, insert assms, elim open_step_cases, auto)

lemma eqButUID_open_eq: "eqButUID s s1 ⟹ open s = open s1"
using open_def eqButUID_def by auto

end

end
itle>

Theory Outer_Friend_Issuer_Value_Setup

(* The value setup for outer friendship status confidentiality *)
theory Outer_Friend_Issuer_Value_Setup
  imports Outer_Friend_Issuer_Openness
begin

subsubsection ‹Value setup›

context OuterFriendIssuer
begin

fun φ :: "(state,act,out) trans ⇒ bool" where
"φ (Trans s (COMact (comSendCreateOFriend uID p aID uID')) ou s') =
  (uID = UID ∧ uID' ∉ UIDs aID ∧ ou ≠ outErr)"
|
"φ (Trans s (COMact (comSendDeleteOFriend uID p aID uID')) ou s') =
  (uID = UID ∧ uID' ∉ UIDs aID ∧ ou ≠ outErr)"
|
"φ (Trans s _ _ s') = (open s ≠ open s')"

fun f :: "(state,act,out) trans ⇒ value" where
"f (Trans s (COMact (comSendCreateOFriend uID p aID uID')) ou s') = FrVal aID uID' True"
|
"f (Trans s (COMact (comSendDeleteOFriend uID p aID uID')) ou s') = FrVal aID uID' False"
|
"f (Trans s _ _ s') = OVal (open s')"


lemma φE:
assumes φ: "φ (Trans s a ou s')" (is "φ ?trn")
and step: "step s a = (ou, s')"
and rs: "reach s"
obtains
  (Friend) p aID uID' where "a = COMact (comSendCreateOFriend UID p aID uID')" "ou ≠ outErr"
                            "f ?trn = FrVal aID uID' True" "uID' ∉ UIDs aID"
| (Unfriend) p aID uID' where "a = COMact (comSendDeleteOFriend UID p aID uID')" "ou ≠ outErr"
                              "f ?trn = FrVal aID uID' False" "uID' ∉ UIDs aID"
| (OpenF) uid p uid' where "a = Cact (cFriend uid p uid')" "ou = outOK" "p = pass s uid"
                           "uid ∈ UIDs AID ∧ uid' = UID ∨ uid = UID ∧ uid' ∈ UIDs AID"
                           "open s'" "¬open s"
                           "f ?trn = OVal True"
| (CloseF) uid p uid' where "a = Dact (dFriend uid p uid')" "ou = outOK" "p = pass s uid"
                            "uid ∈ UIDs AID ∧ uid' = UID ∨ uid = UID ∧ uid' ∈ UIDs AID"
                            "open s" "¬open s'"
                            "f ?trn = OVal False"
proof cases
  assume "open s = open s'"
  with φ show thesis by (elim φ.elims) (auto intro: Friend Unfriend)
next
  assume "open s ≠ open s'"
  then show thesis proof (elim open_step_cases[OF _ step], goal_cases)
    case 1 then show ?case by (intro OpenF) auto next
    case 2 then show ?case by (intro CloseF) auto
  qed
qed


(* major *) lemma eqButUID_step_γ_out:
assumes ss1: "eqButUID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
(*and sT: "reachNT s" and s1: "reachNT s1"*)
and γ: "γ (Trans s a ou s')"
and os1: "¬open s1"
and φ: "φ (Trans s1 a ou1 s1') ⟷ φ (Trans s a ou s')"
shows "ou = ou1"
proof -
  obtain uid sa com_act where uid_a: "(userOfA a = Some uid ∧ uid ∈ UIDs AID ∧ uid ≠ UID)
                                      ∨ a = COMact com_act ∨ a = Sact sa"
    using γ UID_UIDs by fastforce
  note simps = eqButUID_not_UID eqButUID_stateSelectors r_defs s_defs c_defs com_defs l_defs u_defs d_defs
  note facts = ss1 step step1 uid_a
  show ?thesis
  proof (cases a)
    case (Ract ra) then show ?thesis using facts by (cases ra) (auto simp add: simps)
  next
    case (Sact sa) then show ?thesis using facts by (cases sa) (auto simp add: simps)
  next
    case (Cact ca) then show ?thesis using facts by (cases ca) (auto simp add: simps)
  next
    case (COMact ca)
      then show ?thesis using facts proof (cases ca)
        case (comSendCreateOFriend uID p aID uID')
          with facts φ show ?thesis using COMact eqButUID_sentOuterFriends_UIDs[OF ss1]
            by (cases "uID = UID") (auto simp: simps)
      next
        case (comSendDeleteOFriend uID p aID uID')
          with facts φ show ?thesis using COMact eqButUID_sentOuterFriends_UIDs[OF ss1]
            by (cases "uID = UID") (auto simp: simps)
      qed (auto simp: simps)
  next
    case (Lact la)
      then show ?thesis using facts proof (cases la)
        case (lSentOuterFriends uID p uID')
          with Lact facts os1 show ?thesis by (cases "uID' = UID") (auto simp: simps open_def)
      next
        case (lInnerPosts uid p)
          then have o: "⋀nid. owner s nid = owner s1 nid"
                and n: "⋀nid. post s nid = post s1 nid"
                and nids: "postIDs s = postIDs s1"
                and vis: "vis s = vis s1"
                and fu: "⋀uid'. friendIDs s uid' = friendIDs s1 uid'"
                and e: "e_listInnerPosts s uid p ⟷ e_listInnerPosts s1 uid p"
            using ss1 unfolding eqButUID_def l_defs by auto
          have "listInnerPosts s uid p = listInnerPosts s1 uid p"
            unfolding listInnerPosts_def o n nids vis fu ..
          with e show ?thesis using Lact lInnerPosts step step1 by auto
      qed (auto simp add: simps)
  next
    case (Uact ua) then show ?thesis using facts by (cases ua) (auto simp add: simps)
  next
    case (Dact da) then show ?thesis using facts by (cases da) (auto simp add: simps)
  qed
qed



lemma step_open_φ:
assumes "step s a = (ou, s')"
and "open s ≠ open s'"
shows "φ (Trans s a ou s')"
using assms by (elim open_step_cases) (auto simp: open_def)

lemma step_sendOFriend_eqButUID:
assumes "step s a = (ou, s')"
and "reach s"
and "uID' ∉ UIDs aID"
and "a = COMact (comSendCreateOFriend UID (pass s UID) aID uID') ∨
     a = COMact (comSendDeleteOFriend UID (pass s UID) aID uID')"
shows "eqButUID s s'"
using assms proof cases
  assume "φ (Trans s a ou s')"
  then show "eqButUID s s'" using assms proof (cases rule: φE)
    case (Friend p aid uid')
      then show ?thesis
        using assms eqButUID_sentOuterFriendIDs_cong[of s s]
        by (auto split: prod.splits simp: com_defs)
  next
    case (Unfriend p aid uid')
      then show ?thesis
        using assms eqButUID_sentOuterFriendIDs_cong[of s s]
        by (auto split: prod.splits simp: com_defs)
  qed auto
qed (auto split: prod.splits)

lemma eqButUID_step_φ_imp:
assumes ss1: "eqButUID s s1"
and rs: "reach s" and rs1: "reach s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and a: "∀aID uID'. uID' ∉ UIDs aID ⟶
                   a ≠ COMact (comSendCreateOFriend UID (pass s UID) aID uID') ∧
                   a ≠ COMact (comSendDeleteOFriend UID (pass s UID) aID uID')"
and φ: "φ (Trans s a ou s')"
shows "φ (Trans s1 a ou1 s1')"
proof -
  have "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
  then have "open s = open s1" and "open s' = open s1'"
    using ss1 by (auto simp: eqButUID_open_eq)
  with φ step step1 show "φ (Trans s1 a ou1 s1')"
    using rs ss1 a by (elim φE) (auto simp: com_defs)
qed

lemma eqButUID_step_φ:
assumes ss1: "eqButUID s s1"
and rs: "reach s" and rs1: "reach s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and a: "∀aID uID'. uID' ∉ UIDs aID ⟶
                   a ≠ COMact (comSendCreateOFriend UID (pass s UID) aID uID') ∧
                   a ≠ COMact (comSendDeleteOFriend UID (pass s UID) aID uID')"
shows "φ (Trans s a ou s') = φ (Trans s1 a ou1 s1')"
proof
  assume "φ (Trans s a ou s')"
  with assms show "φ (Trans s1 a ou1 s1')" by (rule eqButUID_step_φ_imp)
next
  assume "φ (Trans s1 a ou1 s1')"
  moreover have "eqButUID s1 s" using ss1 by (rule eqButUID_sym)
  moreover have "∀aID uID'. uID' ∉ UIDs aID ⟶
                   a ≠ COMact (comSendCreateOFriend UID (pass s1 UID) aID uID') ∧
                   a ≠ COMact (comSendDeleteOFriend UID (pass s1 UID) aID uID')"
    using a ss1 by (auto simp: eqButUID_stateSelectors)
  ultimately show "φ (Trans s a ou s')" using rs rs1 step step1
    by (intro eqButUID_step_φ_imp[of s1 s])
qed

lemma eqButUID_step_γ:
assumes ss1: "eqButUID s s1"
and rs: "reach s" and rs1: "reach s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and a: "∀aID uID'. uID' ∉ UIDs aID ⟶
                   a ≠ COMact (comSendCreateOFriend UID (pass s UID) aID uID') ∧
                   a ≠ COMact (comSendDeleteOFriend UID (pass s UID) aID uID')"
shows "γ (Trans s a ou s') = γ (Trans s1 a ou1 s1')"
proof -
  { fix ca
    assume a: "a = COMact ca"
    then have "ou = ou1" using assms proof (cases ca)
      case (comSendCreateOFriend uid p aid uid')
        with assms a show ?thesis
          by (cases "uid = UID"; cases "uid' ∈ UIDs aid")
             (auto simp: com_defs eqButUID_def eqButUID_sentOuterFriends_UIDs eqButUID_not_UID)
    next
      case (comSendDeleteOFriend uid p aid uid')
        with assms a show ?thesis
          by (cases "uid = UID"; cases "uid' ∈ UIDs aid")
             (auto simp: com_defs eqButUID_def eqButUID_sentOuterFriends_UIDs eqButUID_not_UID)
    qed (auto simp: com_defs eqButUID_def)
  }
  with assms show ?thesis by auto
qed


end

end
>

Theory Outer_Friend_Issuer

theory Outer_Friend_Issuer
  imports
    "Outer_Friend_Issuer_Value_Setup"
    "Bounded_Deducibility_Security.Compositional_Reasoning"
begin

subsubsection ‹Declassification bound›

(* We verify the following:
   Given an arbitrary but fixed user UID at node AID (who is not an observer) and a set of
   observers at each network node, the observers may learn about the *occurrence* of remote
   friendship actions of UID (because network traffic is assumed to be observable), but they
   learn nothing about the *content* of those actions (who was added or deleted as a friend)
   beyond public knowledge (friendship addition and deletion occur alternatingly),
   except if the action adds or deletes one of the observers themselves as friend.
*)

context OuterFriendIssuer
begin

fun T :: "(state,act,out) trans ⇒ bool"
where "T trn = False"

text ‹For each user ‹uid› at a node ‹aid›, the remote friendship updates with
the fixed user ‹UID› at node ‹AID› form an alternating sequence of friending and unfriending.

Note that actions involving remote users who are observers do not produce secret values;
instead, those actions are observable, and the property we verify does not protect their
confidentiality.›

fun validValSeq :: "value list ⇒ (apiID × userID) list ⇒ bool" where
  "validValSeq [] _ = True"
| "validValSeq (FrVal aid uid True # vl) auidl ⟷ (aid, uid) ∉ set auidl ∧ uid ∉ UIDs aid ∧ validValSeq vl (auidl ## (aid, uid))"
| "validValSeq (FrVal aid uid False # vl) auidl ⟷ (aid, uid) ∈∈ auidl ∧ uid ∉ UIDs aid ∧ validValSeq vl (removeAll (aid, uid) auidl)"
| "validValSeq (OVal _ # vl) auidl = validValSeq vl auidl"

abbreviation validValSeqFrom :: "value list ⇒ state ⇒ bool" where
  "validValSeqFrom vl s ≡ validValSeq vl (removeUIDs (sentOuterFriendIDs s UID))"

text ‹When the access window is closed, observers may learn about the occurrence of
remote friendship actions (by observing network traffic), but not their content;
the actions can be replaced by different actions involving different users (who are not observers)
without affecting the observations.›

inductive BC :: "value list ⇒ value list ⇒ bool"
where
  BC_Nil[simp,intro]: "BC [] []"
| BC_FrVal[intro]:
    "BC vl vl1 ⟹ uid' ∉ UIDs aid ⟹ BC (FrVal aid uid st # vl) (FrVal aid uid' st' # vl1)"

text ‹When the access window is open, i.e.~the user ‹UID› is a local friend of an observer,
all information about the remote friends of ‹UID› is declassified;
when the access window closes again, the contents of future updates are kept confidential.›

definition "BO vl vl1 ≡
 (vl1 = vl) ∨
 (∃vl0 vl' vl1'. vl = vl0 @ OVal False # vl' ∧ vl1 = vl0 @ OVal False # vl1' ∧ BC vl' vl1')"

definition "B vl vl1 ≡ (BC vl vl1 ∨ BO vl vl1) ∧ validValSeqFrom vl1 istate"


lemma B_Nil_Nil: "B vl vl1 ⟹ vl1 = [] ⟷ vl = []"
unfolding B_def BO_def by (auto elim: BC.cases)

sublocale BD_Security_IO where
istate = istate and step = step and
φ = φ and f = f and γ = γ and g = g and T = T and B = B
done


subsubsection ‹Unwinding proof›

definition Δ0 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ0 s vl s1 vl1 ≡
 s1 = istate ∧ s = istate ∧ B vl vl1"


definition Δ1 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ1 s vl s1 vl1 ≡
 BO vl vl1 ∧
 s1 = s ∧
 validValSeqFrom vl1 s1"


definition Δ2 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ2 s vl s1 vl1 ≡
 BC vl vl1 ∧
 eqButUID s s1 ∧ ¬open s1 ∧
 validValSeqFrom vl1 s1"


lemma validValSeq_prefix: "validValSeq (vl @ vl') auidl ⟹ validValSeq vl auidl"
by (induction vl arbitrary: auidl) (auto elim: validValSeq.elims)

lemma filter_removeAll: "filter P (removeAll x xs) = removeAll x (filter P xs)"
unfolding removeAll_filter_not_eq by (auto intro: filter_cong)

lemma step_validValSeqFrom:
assumes step: "step s a = (ou, s')"
and rs: "reach s"
and c: "consume (Trans s a ou s') vl vl'" (is "consume ?trn vl vl'")
and vVS: "validValSeqFrom vl s"
shows "validValSeqFrom vl' s'"
proof cases
  assume "φ ?trn"
  moreover then obtain v where "vl = v # vl'" using c by (cases vl, auto simp: consume_def)
  moreover have "distinct (sentOuterFriendIDs s UID)" using rs by (intro reach_distinct_friends_reqs)
  ultimately show ?thesis using assms
    by (elim φE)
       (auto simp: com_defs c_defs d_defs consume_def distinct_remove1_removeAll filter_removeAll)
next
  assume nφ: "¬φ ?trn"
  then have vl': "vl' = vl" using c by (auto simp: consume_def)
  then show ?thesis using vVS step proof (cases a)
    case (Sact sa) then show ?thesis using assms vl' by (cases sa) (auto simp: s_defs) next
    case (Cact ca) then show ?thesis using assms vl' by (cases ca) (auto simp: c_defs) next
    case (Dact da) then show ?thesis using assms vl' by (cases da) (auto simp: d_defs) next
    case (Uact ua) then show ?thesis using assms vl' by (cases ua) (auto simp: u_defs) next
    case (COMact ca) then show ?thesis using assms vl' nφ by (cases ca) (auto simp: com_defs filter_remove1)
  qed auto
qed

lemma istate_Δ0:
assumes B: "B vl vl1"
shows "Δ0 istate vl istate vl1"
using assms unfolding Δ0_def
by auto

lemma unwind_cont_Δ0: "unwind_cont Δ0 {Δ1,Δ2}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ1 s vl s1 vl1 ∨
                           Δ2 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Δ0: "Δ0 s vl s1 vl1"
  then have rs: "reach s" and s: "s = istate" and s1: "s1 = istate" and B: "B vl vl1"
    using reachNT_reach unfolding Δ0_def by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof (intro disjI1)
        obtain uid p where a: "a = Sact (sSys uid p) ∨ s' = s"
          using step unfolding s by (elim istate_sSys) auto
        have "¬open s'" using step a s by (auto simp: istate_def s_defs open_def)
        moreover then have "¬φ ?trn" using step rs a by (auto elim!: φE simp: s istate_def com_defs)
        moreover have "sentOuterFriendIDs s' UID = sentOuterFriendIDs s UID"
          using s a step by (auto simp: s_defs)
        ultimately show "?match" using s s1 step B c unfolding Δ1_def Δ2_def B_def
          by (intro matchI[of s1 a ou s' vl1 vl1]) (auto simp: consume_def)
      qed
    qed
    with B_Nil_Nil[OF B] show ?thesis by auto
  qed
qed


lemma unwind_cont_Δ1: "unwind_cont Δ1 {Δ1,Δ2}"
proof(rule, simp)
  let ?Δ = "λs vl s1 vl1. Δ1 s vl s1 vl1 ∨
                           Δ2 s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Δ0: "Δ1 s vl s1 vl1"
  then have rs: "reach s" and s: "s1 = s" and BO: "BO vl vl1"
        and vVS1: "validValSeqFrom vl1 s1"
    using reachNT_reach unfolding Δ1_def by auto
  show "iaction ?Δ s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction ?Δ s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      show "match ?Δ s s1 vl1 a ou s' vl' ∨ ignore ?Δ s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof cases
        assume φ: "φ ?trn"
        consider (Eq) "vl1 = vl"
          | (BC) vl0 vl'' vl1'' where "vl = vl0 @ OVal False # vl''"
                                and "vl1 = vl0 @ OVal False # vl1''"
                                and "BC vl'' vl1''"
          using BO
          by (auto simp: BO_def)
        then have "?match"
        proof cases
          case Eq
          then show ?thesis
            using step s c vVS1 step_validValSeqFrom[OF step rs c]
            by (intro matchI[of s1 a ou s' vl1 vl']) (auto simp: Δ1_def BO_def)
        next
          case BC
          show "?match" proof (cases vl0)
            case Nil
              then have "consume ?trn vl1 vl1''" and "vl' = vl''" and f: "f ?trn = OVal False"
                using φ c BC by (auto simp: consume_def)
              moreover then have "validValSeqFrom vl1'' s'"
                using s rs vVS1 by (intro step_validValSeqFrom[OF step]) auto
              moreover have "¬open s'" using φ step rs f by (auto elim: φE)
              ultimately show ?thesis
                using step s BC by (intro matchI[of s1 a ou s' vl1 vl1'']) (auto simp: Δ2_def)
          next
            case (Cons v vl0')
              then have "consume ?trn vl1 (vl0' @ OVal False # vl1'')" and "vl' = vl0' @ OVal False # vl''"
                using φ c BC by (auto simp: consume_def)
              moreover then have "validValSeqFrom (vl0' @ OVal False # vl1'') s'"
                using s rs vVS1 by (intro step_validValSeqFrom[OF step]) auto
              ultimately show ?thesis
                using step s BC
                by (intro matchI[of s1 a ou s' vl1 "(vl0' @ OVal False # vl1'')"]) (auto simp: Δ1_def BO_def)
          qed
        qed
        then show "?match ∨ ?ignore" ..
      next
        assume nφ: "¬φ ?trn"
        then have "consume ?trn vl1 vl1" and "vl' = vl" using c by (auto simp: consume_def)
        moreover then have "validValSeqFrom vl1 s'"
          using s rs vVS1 by (intro step_validValSeqFrom[OF step]) auto
        ultimately have "?match"
          using step s BO by (intro matchI[of s1 a ou s' vl1 vl1]) (auto simp: Δ1_def)
        then show "?match ∨ ?ignore" ..
      qed
    qed
    with BO show ?thesis by (auto simp: BO_def)
  qed
qed

lemma unwind_cont_Δ2: "unwind_cont Δ2 {Δ2}"
proof(rule, simp)
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Δ2: "Δ2 s vl s1 vl1"
  then have rs: "reach s" and ss1: "eqButUID s s1" and BC: "BC vl vl1"
        and os: "¬open s1" and vVS1: "validValSeqFrom vl1 s1"
    using reachNT_reach unfolding Δ2_def by auto
  show "iaction Δ2 s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction Δ2 s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      show "match Δ2 s s1 vl1 a ou s' vl' ∨ ignore Δ2 s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof cases
        assume φ: "φ ?trn"
        with BC c have "?match" proof (cases rule: BC.cases)
          case (BC_FrVal vl'' vl1'' uid' aid uid st st')
            then show ?thesis proof (cases st')
              case True
                let ?a1 = "COMact (comSendCreateOFriend UID (pass s1 UID) aid uid')"
                let ?ou1 = "O_sendCreateOFriend (aid, clientPass s aid, UID, uid')"
                let ?s1' = "snd (sendCreateOFriend s1 UID (pass s1 UID) aid uid')"
                let ?trn1 = "Trans s1 ?a1 ?ou1 ?s1'"
                have c1: "consume ?trn1 vl1 vl1''" and "vl' = vl''" and "f ?trn = FrVal aid uid st"
                  using φ c BC_FrVal True by (auto simp: consume_def)
                moreover then have a: "(a = COMact (comSendCreateOFriend UID (pass s UID) aid uid)
                                        ∧ ou = O_sendCreateOFriend (aid, clientPass s aid, UID, uid))
                                     ∨ (a = COMact (comSendDeleteOFriend UID (pass s UID) aid uid)
                                        ∧ ou = O_sendDeleteOFriend (aid, clientPass s aid, UID, uid))"
                               and IDs: "IDsOK s [UID] [] [] [aid]"
                               and uid: "uid ∉ UIDs aid"
                  using φ step rs by (auto elim!: φE split: prod.splits simp: com_defs)
                moreover have step1: "step s1 ?a1 = (?ou1, ?s1')"
                  using IDs vVS1 BC_FrVal True ss1 by (auto simp: com_defs eqButUID_def)
                moreover then have "validValSeqFrom vl1'' ?s1'"
                  using vVS1 rs1 c1 by (intro step_validValSeqFrom[OF step1]) auto
                moreover have "¬open ?s1'" using os by (auto simp: open_def com_defs)
                moreover have "eqButUID s' ?s1'"
                  using ss1 step a uid BC_FrVal(4) eqButUID_eqButUIDf[OF ss1] eqButUID_eqButUIDs[OF ss1]
                  by (auto split: prod.splits simp: com_defs filter_remove1 intro!: eqButUID_cong eqButUIDf_cong)
                moreover have "γ ?trn = γ ?trn1" and "g ?trn = g ?trn1"
                  using BC_FrVal a uid by (auto simp: com_defs)
                ultimately show "?match"
                  using BC_FrVal by (intro matchI[of s1 ?a1 ?ou1 ?s1' vl1 vl1'']) (auto simp: Δ2_def)
            next
              case False
                let ?a1 = "COMact (comSendDeleteOFriend UID (pass s1 UID) aid uid')"
                let ?ou1 = "O_sendDeleteOFriend (aid, clientPass s aid, UID, uid')"
                let ?s1' = "snd (sendDeleteOFriend s1 UID (pass s1 UID) aid uid')"
                let ?trn1 = "Trans s1 ?a1 ?ou1 ?s1'"
                have c1: "consume ?trn1 vl1 vl1''" and "vl' = vl''" and "f ?trn = FrVal aid uid st"
                  using φ c BC_FrVal False by (auto simp: consume_def)
                moreover then have a: "(a = COMact (comSendCreateOFriend UID (pass s UID) aid uid)
                                        ∧ ou = O_sendCreateOFriend (aid, clientPass s aid, UID, uid))
                                     ∨ (a = COMact (comSendDeleteOFriend UID (pass s UID) aid uid)
                                        ∧ ou = O_sendDeleteOFriend (aid, clientPass s aid, UID, uid))"
                               and IDs: "IDsOK s [UID] [] [] [aid]"
                               and uid: "uid ∉ UIDs aid"
                  using φ step rs by (auto elim!: φE split: prod.splits simp: com_defs)
                moreover have step1: "step s1 ?a1 = (?ou1, ?s1')"
                  using IDs vVS1 BC_FrVal False ss1 by (auto simp: com_defs eqButUID_def)
                moreover then have "validValSeqFrom vl1'' ?s1'"
                  using vVS1 rs1 c1 by (intro step_validValSeqFrom[OF step1]) auto
                moreover have "¬open ?s1'" using os by (auto simp: open_def com_defs)
                moreover have "eqButUID s' ?s1'"
                  using ss1 step a uid BC_FrVal(4) eqButUID_eqButUIDf[OF ss1] eqButUID_eqButUIDs[OF ss1]
                  by (auto split: prod.splits simp: com_defs filter_remove1 intro!: eqButUID_cong eqButUIDf_cong)
                moreover have "γ ?trn = γ ?trn1" and "g ?trn = g ?trn1"
                  using BC_FrVal a uid by (auto simp: com_defs)
                ultimately show "?match"
                  using BC_FrVal by (intro matchI[of s1 ?a1 ?ou1 ?s1' vl1 vl1'']) (auto simp: Δ2_def)
            qed
        qed (auto simp: consume_def)
        then show "?match ∨ ?ignore" ..
      next
        assume nφ: "¬φ ?trn"
        then have vl': "vl' = vl" using c by (auto simp: consume_def)
        obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by (cases "step s1 a")
        let ?trn1 = "Trans s1 a ou1 s1'"
        show "?match ∨ ?ignore"
        proof (cases "∀aID uID'. uID' ∉ UIDs aID ⟶
                                 a ≠ COMact (comSendCreateOFriend UID (pass s UID) aID uID') ∧
                                 a ≠ COMact (comSendDeleteOFriend UID (pass s UID) aID uID')")
          case True
            then have nφ1: "¬φ ?trn1"
              using nφ ss1 rs rs1 step step1 by (auto simp: eqButUID_step_φ)
            have "?match" using step1 unfolding vl' proof (intro matchI[of s1 a ou1 s1' vl1 vl1])
              show c1: "consume ?trn1 vl1 vl1" using nφ1 by (auto simp: consume_def)
              show "Δ2 s' vl s1' vl1" using BC unfolding Δ2_def proof (intro conjI)
                show "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
                show "¬open s1'" proof
                  assume "open s1'"
                  with os have "open s1 ≠ open s1'" by auto
                  then show "False" using step1 nφ1 by (elim open_step_cases[of s1 s1']) auto
                qed
                show "validValSeqFrom vl1 s1'"
                  using c1 rs1 vVS1 by (intro step_validValSeqFrom[OF step1]) auto
              qed auto
              show "γ ?trn = γ ?trn1" using ss1 rs rs1 step step1 True by (intro eqButUID_step_γ) auto
            next
              assume "γ ?trn"
              then have "ou = ou1" using os nφ nφ1 by (intro eqButUID_step_γ_out[OF ss1 step step1]) auto
              then show "g ?trn = g ?trn1" by (cases a) auto
            qed auto
            then show "?match ∨ ?ignore" ..
        next
          case False
            with nφ have "?ignore"
              using UID_UIDs BC step ss1 os vVS1 unfolding vl'
              by (intro ignoreI) (auto simp: Δ2_def split: prod.splits)
            then show "?match ∨ ?ignore" ..
        qed
      qed
    qed
    with BC show ?thesis by (cases rule: BC.cases) auto
  qed
qed

definition Gr where
"Gr =
 {
 (Δ0, {Δ1,Δ2}),
 (Δ1, {Δ1,Δ2}),
 (Δ2, {Δ2})
 }"


theorem secure: secure
apply (rule unwind_decomp_secure_graph[of Gr Δ0])
unfolding Gr_def
apply (simp, smt insert_subset order_refl)
using
istate_Δ0 unwind_cont_Δ0 unwind_cont_Δ1 unwind_cont_Δ2
unfolding Gr_def by (auto intro: unwind_cont_mono)

end

end
Setup

Theory Outer_Friend_Receiver_Observation_Setup

theory Outer_Friend_Receiver_Observation_Setup
  imports "../Outer_Friend"
begin

subsection ‹Receiver nodes›

subsubsection ‹Observation setup›

(* We now consider one arbitrary, but fixed network node receiving secrets *)
locale OuterFriendReceiver = OuterFriend +
fixes AID' :: apiID ― ‹The ID of this (arbitrary, but fixed) receiver node›
begin

(*  *)
fun γ :: "(state,act,out) trans ⇒ bool" where
"γ (Trans _ a ou _) ⟷ (∃ uid. userOfA a = Some uid ∧ uid ∈ UIDs AID') ∨
                        (∃ca. a = COMact ca ∧ ou ≠ outErr)"

(* Note: the passwords don't really have to be purged (since identity theft is not
considered in the first place); however, purging passwords looks more sane. *)

(* Purging the password in starting actions: *)
fun sPurge :: "sActt ⇒ sActt" where
"sPurge (sSys uid pwd) = sSys uid emptyPass"

(* Purging communicating actions: password information is removed, the user IDs of friends
   added or deleted by UID are removed, and the information whether UID added or deleted
   a friend is removed *)
fun comPurge :: "comActt ⇒ comActt" where
 "comPurge (comSendServerReq uID p aID reqInfo) = comSendServerReq uID emptyPass aID reqInfo"
|"comPurge (comReceiveClientReq aID reqInfo) = comReceiveClientReq aID reqInfo"
|"comPurge (comConnectClient uID p aID sp) = comConnectClient uID emptyPass aID sp"
|"comPurge (comConnectServer aID sp) = comConnectServer aID sp"
|"comPurge (comReceivePost aID sp nID nt uID v) = comReceivePost aID sp nID nt uID v"
|"comPurge (comSendPost uID p aID nID) = comSendPost uID emptyPass aID nID"
|"comPurge (comSendCreateOFriend uID p aID uID') = comSendCreateOFriend uID emptyPass aID uID'"
    (*(if aID = AID ∧ uID = UID ∧ uID' ∉ UIDs AID'
     then comSendCreateOFriend uID emptyPass aID emptyUserID
     else comSendCreateOFriend uID emptyPass aID uID')"*)
|"comPurge (comReceiveCreateOFriend aID cp uID uID') =
    (if aID = AID ∧ uID = UID ∧ uID' ∉ UIDs AID'
     then comReceiveCreateOFriend aID cp uID emptyUserID
     else comReceiveCreateOFriend aID cp uID uID')"
|"comPurge (comSendDeleteOFriend uID p aID uID') = comSendDeleteOFriend uID emptyPass aID uID'"
    (*(if aID = AID ∧ uID = UID ∧ uID' ∉ UIDs AID'
     then comSendCreateOFriend uID emptyPass aID emptyUserID
     else comSendDeleteOFriend uID emptyPass aID uID')"*)
|"comPurge (comReceiveDeleteOFriend aID cp uID uID') =
    (if aID = AID ∧ uID = UID ∧ uID' ∉ UIDs AID'
     then comReceiveCreateOFriend aID cp uID emptyUserID
     else comReceiveDeleteOFriend aID cp uID uID')"

lemma comPurge_simps:
  "comPurge ca = comSendServerReq uID p aID reqInfo ⟷ (∃p'. ca = comSendServerReq uID p' aID reqInfo ∧ p = emptyPass)"
  "comPurge ca = comReceiveClientReq aID reqInfo ⟷ ca = comReceiveClientReq aID reqInfo"
  "comPurge ca = comConnectClient uID p aID sp ⟷ (∃p'. ca = comConnectClient uID p' aID sp ∧ p = emptyPass)"
  "comPurge ca = comConnectServer aID sp ⟷ ca = comConnectServer aID sp"
  "comPurge ca = comReceivePost aID sp nID nt uID v ⟷ ca = comReceivePost aID sp nID nt uID v"
  "comPurge ca = comSendPost uID p aID nID ⟷ (∃p'. ca = comSendPost uID p' aID nID ∧ p = emptyPass)"
  "comPurge ca = comSendCreateOFriend uID p aID uID' ⟷ (∃p'. ca = comSendCreateOFriend uID p' aID uID' ∧ p = emptyPass)"
  "comPurge ca = comReceiveCreateOFriend aID cp uID uID'
⟷ (∃uid''. (ca = comReceiveCreateOFriend aID cp uID uid'' ∨ ca = comReceiveDeleteOFriend aID cp uID uid'') ∧ aID = AID ∧ uID = UID ∧ uid'' ∉ UIDs AID' ∧ uID' = emptyUserID)
    ∨ (ca = comReceiveCreateOFriend aID cp uID uID' ∧ ¬(aID = AID ∧ uID = UID ∧ uID' ∉ UIDs AID'))"
  "comPurge ca = comSendDeleteOFriend uID p aID uID' ⟷ (∃p'. ca = comSendDeleteOFriend uID p' aID uID' ∧ p = emptyPass)"
  "comPurge ca = comReceiveDeleteOFriend aID cp uID uID' ⟷ ca = comReceiveDeleteOFriend aID cp uID uID' ∧ ¬(aID = AID ∧ uID = UID ∧ uID' ∉ UIDs AID')"
by (cases ca; auto)+

(* Purging outputs: password information is removed, and the user IDs of friends added or deleted
   by UID are removed from the only kind of output that may contain such info: outAIDPUIDUID   *)
(*n outPurge :: "out ⇒ out" where
 "outPurge (outAIDPUIDUID (aID, sp, uID, uID')) =
  (if aID = AID ∧ uID = UID ∧ uID' ∉ UIDs AID'
   then outAIDPUIDUID (aID, sp, uID, emptyUserID)
   else outAIDPUIDUID (aID, sp, uID, uID'))"
|"outPurge ou = ou"

lemma outPurge_outErr[simp]: "outPurge ou = outErr ⟷ ou = outErr"
by (cases ou) auto*)

fun g :: "(state,act,out)trans ⇒ obs" where
 "g (Trans _ (Sact sa) ou _) = (Sact (sPurge sa), ou)"
|"g (Trans _ (COMact ca) ou _) = (COMact (comPurge ca), ou)"
|"g (Trans _ a ou _) = (a,ou)"

lemma g_simps:
  "g (Trans s a ou s') = (COMact (comSendServerReq uID p aID reqInfo), ou')
⟷ (∃p'. a = COMact (comSendServerReq uID p' aID reqInfo) ∧ p = emptyPass ∧ ou = ou')"
  "g (Trans s a ou s') = (COMact (comReceiveClientReq aID reqInfo), ou')
⟷ a = COMact (comReceiveClientReq aID reqInfo) ∧ ou = ou'"
  "g (Trans s a ou s') = (COMact (comConnectClient uID p aID sp), ou')
⟷ (∃p'. a = COMact (comConnectClient uID p' aID sp) ∧ p = emptyPass ∧ ou = ou')"
  "g (Trans s a ou s') = (COMact (comConnectServer aID sp), ou')
⟷ a = COMact (comConnectServer aID sp) ∧ ou = ou'"
  "g (Trans s a ou s') = (COMact (comReceivePost aID sp nID nt uID v), ou')
⟷ a = COMact (comReceivePost aID sp nID nt uID v) ∧ ou = ou'"
  "g (Trans s a ou s') = (COMact (comSendPost uID p aID nID), ou')
⟷ (∃p'. a = COMact (comSendPost uID p' aID nID) ∧ p = emptyPass ∧ ou = ou')"
  "g (Trans s a ou s') = (COMact (comSendCreateOFriend uID p aID uID'), ou')
⟷ (∃p'. a = COMact (comSendCreateOFriend uID p' aID uID') ∧ p = emptyPass ∧ ou = ou')"
  "g (Trans s a ou s') = (COMact (comReceiveCreateOFriend aID cp uID uID'), ou')
⟷ (((∃uid''. (a = COMact (comReceiveCreateOFriend aID cp uID uid'') ∨ a = COMact (comReceiveDeleteOFriend aID cp uID uid'')) ∧ aID = AID ∧ uID = UID ∧ uid'' ∉ UIDs AID' ∧ uID' = emptyUserID)
    ∨ (a = COMact (comReceiveCreateOFriend aID cp uID uID') ∧ ¬(aID = AID ∧ uID = UID ∧ uID' ∉ UIDs AID')))
    ∧ ou = ou')"
  "g (Trans s a ou s') = (COMact (comSendDeleteOFriend uID p aID uID'), ou')
⟷ (∃p'. a = COMact (comSendDeleteOFriend uID p' aID uID') ∧ p = emptyPass ∧ ou = ou')"
  "g (Trans s a ou s') = (COMact (comReceiveDeleteOFriend aID cp uID uID'), ou')
⟷ a = COMact (comReceiveDeleteOFriend aID cp uID uID') ∧ ¬(aID = AID ∧ uID = UID ∧ uID' ∉ UIDs AID') ∧ ou = ou'"
by (cases a; auto simp: comPurge_simps)+

end

(*
locale FriendNetworkObservationSetup =
fixes UIDs :: "apiID ⇒ userID set"
and UID :: "userID"
begin

(*  *)
abbreviation γ :: "apiID ⇒ (state,act,out) trans ⇒ bool" where
"γ aid trn ≡ FriendObservationSetup.γ (UIDs aid) trn"

abbreviation g :: "apiID ⇒ (state,act,out)trans ⇒ obs" where
"g aid trn ≡ FriendObservationSetup.g UID trn"

end
*)

end
inguishability

Theory Outer_Friend_Receiver_State_Indistinguishability

(* The state equivalence used for the unwinding proofs for the friendship confidentiality
   properties *)
theory Outer_Friend_Receiver_State_Indistinguishability
  imports Outer_Friend_Receiver_Observation_Setup
begin

subsubsection ‹Unwinding helper definitions and lemmas›

context OuterFriendReceiver
begin

(* The notion of two (apiID × userID) lists being equal except for an occurrence of (AID, UID): *)
fun eqButUIDl :: "(apiID × userID) list ⇒ (apiID × userID) list ⇒ bool" where
"eqButUIDl auidl auidl1 = (remove1 (AID,UID) auidl = remove1 (AID,UID) auidl1)"

lemma eqButUIDl_eq[simp,intro!]: "eqButUIDl auidl auidl"
by auto

lemma eqButUIDl_sym:
assumes "eqButUIDl auidl auidl1"
shows "eqButUIDl auidl1 auidl"
using assms by auto

lemma eqButUIDl_trans:
assumes "eqButUIDl auidl auidl1" and "eqButUIDl auidl1 auidl2"
shows "eqButUIDl auidl auidl2"
using assms by auto

lemma eqButUIDl_remove1_cong:
assumes "eqButUIDl auidl auidl1"
shows "eqButUIDl (remove1 auid auidl) (remove1 auid auidl1)"
using assms by (auto simp: remove1_commute)


lemma eqButUIDl_snoc_cong:
assumes "eqButUIDl auidl auidl1"
and "auid' ∈∈ auidl ⟷ auid' ∈∈ auidl1"
shows "eqButUIDl (auidl ## auid') (auidl1 ## auid')"
using assms by (auto simp: remove1_append remove1_idem)


(* The notion of two functions each taking a userID being equal for observers,
   and eqButUIDs for others. *)
definition eqButUIDf where
"eqButUIDf frds frds1 ≡
  (∀uid. if uid ∈ UIDs AID' then frds uid = frds1 uid else eqButUIDl (frds uid) (frds1 uid))"

lemmas eqButUIDf_intro = eqButUIDf_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eqButUIDf_eeq[simp,intro!]: "eqButUIDf frds frds"
unfolding eqButUIDf_def by auto

lemma eqButUIDf_sym:
assumes "eqButUIDf frds frds1" shows "eqButUIDf frds1 frds"
using assms unfolding eqButUIDf_def
by auto

lemma eqButUIDf_trans:
assumes "eqButUIDf frds frds1" and "eqButUIDf frds1 frds2"
shows "eqButUIDf frds frds2"
using assms unfolding eqButUIDf_def by fastforce

lemma eqButUIDf_cong:
assumes "eqButUIDf frds frds1"
and "uid ∈ UIDs AID' ⟹ uu = uu1"
and "uid ∉ UIDs AID' ⟹ eqButUIDl uu uu1"
shows "eqButUIDf (frds (uid := uu)) (frds1(uid := uu1))"
using assms unfolding eqButUIDf_def by auto
(*
lemma eqButUIDf_eqButUIDl:
assumes "eqButUIDf frds frds1"
shows "eqButUIDl UID2 (frds UID1) (frds1 UID1)"
  and "eqButUIDl UID1 (frds UID2) (frds1 UID2)"
using assms unfolding eqButUIDf_def by (auto split: if_splits)
*)
lemma eqButUIDf_UIDs:
"⟦eqButUIDf frds frds1; uid ∈ UIDs AID'⟧ ⟹ frds uid = frds1 uid"
unfolding eqButUIDf_def by (auto split: if_splits)
(*
lemma eqButUIDf_not_UID':
assumes eq1: "eqButUIDf frds frds1"
and uid: "(uid,uid') ∉ {(UID1,UID2), (UID2,UID1)}"
shows "uid ∈∈ frds uid' ⟷ uid ∈∈ frds1 uid'"
proof -
  from uid have "(uid' = UID1 ∧ uid ≠ UID2)
               ∨ (uid' = UID2 ∧ uid ≠ UID1)
               ∨ (uid' ∉ {UID1,UID2})" (is "?u1 ∨ ?u2 ∨ ?n12")
    by auto
  then show ?thesis proof (elim disjE)
    assume "?u1"
    moreover then have "uid ∈∈ remove1 UID2 (frds uid') ⟷ uid ∈∈ remove1 UID2 (frds1 uid')"
      using eq1 unfolding eqButUIDf_def by auto
    ultimately show ?thesis by auto
  next
    assume "?u2"
    moreover then have "uid ∈∈ remove1 UID1 (frds uid') ⟷ uid ∈∈ remove1 UID1 (frds1 uid')"
      using eq1 unfolding eqButUIDf_def by auto
    ultimately show ?thesis by auto
  next
    assume "?n12"
    then show ?thesis using eq1 unfolding eqButUIDf_def by auto
  qed
qed

(* The notion of two functions each taking two userID arguments being
  equal everywhere but on the values (UID1,UID2) and (UID2,UID1): *)
definition eqButUID12 where
"eqButUID12 freq freq1 ≡
 ∀ uid uid'. if (uid,uid') ∈ {(UID1,UID2), (UID2,UID1)} then True else freq uid uid' = freq1 uid uid'"

lemmas eqButUID12_intro = eqButUID12_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eqButUID12_eeq[simp,intro!]: "eqButUID12 freq freq"
unfolding eqButUID12_def by auto

lemma eqButUID12_sym:
assumes "eqButUID12 freq freq1" shows "eqButUID12 freq1 freq"
using assms unfolding eqButUID12_def
by presburger

lemma eqButUID12_trans:
assumes "eqButUID12 freq freq1" and "eqButUID12 freq1 freq2"
shows "eqButUID12 freq freq2"
using assms unfolding eqButUID12_def by (auto split: if_splits)

lemma eqButUID12_cong:
assumes "eqButUID12 freq freq1"
(*and "uid = UID1 ⟹ eqButUID2 uu uu1"*)
and "¬ (uid,uid') ∈ {(UID1,UID2), (UID2,UID1)} ⟹ uu = uu1"
shows "eqButUID12 (fun_upd2 freq uid uid' uu) (fun_upd2 freq1 uid uid' uu1)"
using assms unfolding eqButUID12_def fun_upd2_def by (auto split: if_splits)

lemma eqButUID12_not_UID:
"⟦eqButUID12 freq freq1; ¬ (uid,uid') ∈ {(UID1,UID2), (UID2,UID1)}⟧ ⟹ freq uid uid' = freq1 uid uid'"
unfolding eqButUID12_def by (auto split: if_splits)
*)

(* The notion of two states being equal everywhere but on the friendship requests or status of users UID1 and UID2: *)
definition eqButUID :: "state ⇒ state ⇒ bool" where
"eqButUID s s1 ≡
 admin s = admin s1 ∧

 pendingUReqs s = pendingUReqs s1 ∧ userReq s = userReq s1 ∧
 userIDs s = userIDs s1 ∧ user s = user s1 ∧ pass s = pass s1 ∧

 pendingFReqs s = pendingFReqs s1 ∧
 friendReq s = friendReq s1 ∧
 friendIDs s = friendIDs s1 ∧

 postIDs s = postIDs s1 ∧ admin s = admin s1 ∧
 post s = post s1 ∧ vis s = vis s1 ∧
 owner s = owner s1 ∧

 pendingSApiReqs s = pendingSApiReqs s1 ∧ sApiReq s = sApiReq s1 ∧
 serverApiIDs s = serverApiIDs s1 ∧ serverPass s = serverPass s1 ∧
 outerPostIDs s = outerPostIDs s1 ∧ outerPost s = outerPost s1 ∧ outerVis s = outerVis s1 ∧
 outerOwner s = outerOwner s1 ∧
 sentOuterFriendIDs s = sentOuterFriendIDs s1 ∧
 eqButUIDf (recvOuterFriendIDs s) (recvOuterFriendIDs s1) ∧

 pendingCApiReqs s = pendingCApiReqs s1 ∧ cApiReq s = cApiReq s1 ∧
 clientApiIDs s = clientApiIDs s1 ∧ clientPass s = clientPass s1 ∧
 sharedWith s = sharedWith s1"

lemmas eqButUID_intro = eqButUID_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eqButUID_refl[simp,intro!]: "eqButUID s s"
unfolding eqButUID_def by auto

lemma eqButUID_sym[sym]:
assumes "eqButUID s s1" shows "eqButUID s1 s"
using assms eqButUIDf_sym unfolding eqButUID_def by auto

lemma eqButUID_trans[trans]:
assumes "eqButUID s s1" and "eqButUID s1 s2" shows "eqButUID s s2"
using assms eqButUIDf_trans unfolding eqButUID_def by metis

(* Implications from eqButUID, including w.r.t. auxiliary operations: *)
lemma eqButUID_stateSelectors:
assumes "eqButUID s s1"
shows "admin s = admin s1"
"pendingUReqs s = pendingUReqs s1" "userReq s = userReq s1"
"userIDs s = userIDs s1" "user s = user s1" "pass s = pass s1"
"pendingFReqs s = pendingFReqs s1"
"friendReq s = friendReq s1"
"friendIDs s = friendIDs s1"

"postIDs s = postIDs s1"
"post s = post s1" "vis s = vis s1"
"owner s = owner s1"

"pendingSApiReqs s = pendingSApiReqs s1" "sApiReq s = sApiReq s1"
"serverApiIDs s = serverApiIDs s1" "serverPass s = serverPass s1"
"outerPostIDs s = outerPostIDs s1" "outerPost s = outerPost s1" "outerVis s = outerVis s1"
"outerOwner s = outerOwner s1"
"sentOuterFriendIDs s = sentOuterFriendIDs s1"
"eqButUIDf (recvOuterFriendIDs s) (recvOuterFriendIDs s1)"

"pendingCApiReqs s = pendingCApiReqs s1" "cApiReq s = cApiReq s1"
"clientApiIDs s = clientApiIDs s1" "clientPass s = clientPass s1"
"sharedWith s = sharedWith s1"

"IDsOK s = IDsOK s1"
using assms unfolding eqButUID_def IDsOK_def[abs_def] by auto

lemma eqButUID_UIDs:
"eqButUID s s1 ⟹ uid ∈ UIDs AID' ⟹ recvOuterFriendIDs s uid = recvOuterFriendIDs s1 uid"
unfolding eqButUID_def eqButUIDf_def by auto

lemma eqButUID_recvOuterFriends_UIDs:
assumes "eqButUID s s1"
and "uid ≠ UID ∨ aid ≠ AID"
shows "(aid, uid) ∈∈ recvOuterFriendIDs s uid' ⟷ (aid, uid) ∈∈ recvOuterFriendIDs s1 uid'"
using assms unfolding eqButUID_def eqButUIDf_def
proof -
  have "(aid, uid) ∈∈ remove1 (AID,UID) (recvOuterFriendIDs s uid')
    ⟷ (aid, uid) ∈∈ remove1 (AID,UID) (recvOuterFriendIDs s1 uid')"
    using assms unfolding eqButUID_def eqButUIDf_def by (cases "uid' ∈ UIDs AID'") auto
  then show ?thesis using assms by auto
qed

lemma eqButUID_remove1_UID_recvOuterFriends:
assumes "eqButUID s s1"
shows "remove1 (AID,UID) (recvOuterFriendIDs s uid) = remove1 (AID,UID) (recvOuterFriendIDs s1 uid)"
using assms unfolding eqButUID_def eqButUIDf_def by (cases "uid ∈ UIDs AID'") auto


lemma eqButUID_cong:
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇admin := uu1⦈) (s1 ⦇admin := uu2⦈)"

"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇pendingUReqs := uu1⦈) (s1 ⦇pendingUReqs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇userReq := uu1⦈) (s1 ⦇userReq := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇userIDs := uu1⦈) (s1 ⦇userIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇user := uu1⦈) (s1 ⦇user := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇pass := uu1⦈) (s1 ⦇pass := uu2⦈)"

"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇postIDs := uu1⦈) (s1 ⦇postIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇owner := uu1⦈) (s1 ⦇owner := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇post := uu1⦈) (s1 ⦇post := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇vis := uu1⦈) (s1 ⦇vis := uu2⦈)"

"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇pendingFReqs := uu1⦈) (s1 ⦇pendingFReqs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇friendReq := uu1⦈) (s1 ⦇friendReq := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇friendIDs := uu1⦈) (s1 ⦇friendIDs := uu2⦈)"

"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇pendingSApiReqs := uu1⦈) (s1 ⦇pendingSApiReqs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇sApiReq := uu1⦈) (s1 ⦇sApiReq := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇serverApiIDs := uu1⦈) (s1 ⦇serverApiIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇serverPass := uu1⦈) (s1 ⦇serverPass := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇outerPostIDs := uu1⦈) (s1 ⦇outerPostIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇outerPost := uu1⦈) (s1 ⦇outerPost := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇outerVis := uu1⦈) (s1 ⦇outerVis := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇outerOwner := uu1⦈) (s1 ⦇outerOwner := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇sentOuterFriendIDs := uu1⦈) (s1 ⦇sentOuterFriendIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ eqButUIDf uu1 uu2 ⟹ eqButUID (s ⦇recvOuterFriendIDs := uu1⦈) (s1 ⦇recvOuterFriendIDs := uu2⦈)"

"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇pendingCApiReqs := uu1⦈) (s1 ⦇pendingCApiReqs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇cApiReq := uu1⦈) (s1 ⦇cApiReq := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇clientApiIDs := uu1⦈) (s1 ⦇clientApiIDs := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇clientPass := uu1⦈) (s1 ⦇clientPass := uu2⦈)"
"⋀ uu1 uu2. eqButUID s s1 ⟹ uu1 = uu2 ⟹ eqButUID (s ⦇sharedWith := uu1⦈) (s1 ⦇sharedWith:= uu2⦈)"
unfolding eqButUID_def by auto

end

end
/title>

Theory Outer_Friend_Receiver_Value_Setup

(* The value setup for outer friendship status confidentiality *)
theory Outer_Friend_Receiver_Value_Setup
  imports Outer_Friend_Receiver_State_Indistinguishability
begin

subsubsection ‹Value Setup›

context OuterFriendReceiver
begin

fun φ :: "(state,act,out) trans ⇒ bool" where
"φ (Trans s (COMact (comReceiveCreateOFriend aID cp uID uID')) ou s') =
  (aID = AID ∧ uID = UID ∧ uID' ∉ UIDs AID' ∧ ou = outOK)"
|
"φ (Trans s (COMact (comReceiveDeleteOFriend aID cp uID uID')) ou s') =
  (aID = AID ∧ uID = UID ∧ uID' ∉ UIDs AID' ∧ ou = outOK)"
|
"φ _ = False"

fun f :: "(state,act,out) trans ⇒ value" where
"f (Trans s (COMact (comReceiveCreateOFriend aID cp uID uID')) ou s') = FrVal AID' uID' True"
|
"f (Trans s (COMact (comReceiveDeleteOFriend aID cp uID uID')) ou s') = FrVal AID' uID' False"
|
"f _ = undefined"



lemma recvOFriend_eqButUID:
assumes "step s a = (ou, s')"
and "reach s"
and "a = COMact (comReceiveCreateOFriend AID cp UID uID') ∨ a = COMact (comReceiveDeleteOFriend AID cp UID uID')"
and "uID' ∉ UIDs AID'"
shows "eqButUID s s'"
using assms reach_distinct_friends_reqs(4) unfolding eqButUID_def eqButUIDf_def
by (auto simp: com_defs remove1_idem remove1_append)


(* major *) lemma eqButUID_step:
assumes ss1: "eqButUID s s1"
and step: "step s a = (ou,s')"
and step1: "step s1 a = (ou1,s1')"
and rs: "reach s"
and rs1: "reach s1"
shows "eqButUID s' s1'"
proof -
  note facts = eqButUID_recvOuterFriends_UIDs[OF ss1] eqButUID_UIDs[OF ss1]
               eqButUID_remove1_UID_recvOuterFriends[OF ss1]
  note simps = eqButUID_stateSelectors s_defs c_defs d_defs u_defs r_defs l_defs com_defs
  note congs = eqButUID_cong eqButUIDf_cong eqButUIDl_snoc_cong eqButUIDl_remove1_cong
  from assms show ?thesis proof (cases a)
    case (Sact sa) with assms show ?thesis by (cases sa) (auto simp: simps congs)
  next
    case (Cact ca) with assms show ?thesis by (cases ca) (auto simp: simps congs)
  next
    case (Uact ua) with assms show ?thesis by (cases ua) (auto simp: simps congs)
  next
    case (Ract ra) with assms show ?thesis by (cases ra) (auto simp: simps congs)
  next
    case (Lact la) with assms show ?thesis by (cases la) (auto simp: simps congs)
  next
    case (COMact ca)
      with assms show ?thesis proof (cases "φ (Trans s a ou s') ∨ φ (Trans s1 a ou1 s1')")
        case True
          then have "eqButUID s s'" and "eqButUID s1 s1'"
            using COMact rs rs1 recvOFriend_eqButUID[OF step] recvOFriend_eqButUID[OF step1]
            by (cases ca; auto)+
          then show "eqButUID s' s1'" using ss1 by (auto intro: eqButUID_sym eqButUID_trans)
      next
        case False
          then show ?thesis using assms facts COMact by (cases ca) (auto simp: simps intro!: congs)
      qed
  next
    case (Dact da) with assms show ?thesis by (cases da) (auto simp: simps congs)
  qed
qed



(* major *) lemma eqButUID_step_γ_out:
assumes ss1: "eqButUID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and φ: "φ (Trans s1 a ou1 s1') ⟷ φ (Trans s a ou s')"
and γ: "γ (Trans s a ou s')"
shows "ou = ou1"
proof -
  obtain uid com_act where uid_a: "(userOfA a = Some uid ∧ uid ∈ UIDs AID')
                                 ∨ (a = COMact com_act ∧ ou ≠ outErr)"
    using γ UID_UIDs by fastforce
  note simps = eqButUID_stateSelectors eqButUID_UIDs[OF ss1] r_defs s_defs c_defs com_defs l_defs u_defs d_defs
  note facts = ss1 step step1 uid_a
  show ?thesis
  proof (cases a)
    case (Ract ra) then show ?thesis using facts by (cases ra) (auto simp add: simps)
  next
    case (Sact sa) then show ?thesis using facts by (cases sa) (auto simp add: simps)
  next
    case (Cact ca) then show ?thesis using facts by (cases ca) (auto simp add: simps)
  next
    case (COMact ca)
      then show ?thesis using facts proof (cases ca)
        case (comReceiveCreateOFriend aid sp uid uid')
          with facts φ show ?thesis using COMact eqButUID_recvOuterFriends_UIDs[OF ss1]
            by (auto simp: simps)
      next
        case (comReceiveDeleteOFriend aid sp uid uid')
          with facts φ show ?thesis using COMact eqButUID_recvOuterFriends_UIDs[OF ss1]
            by (auto simp: simps)
      qed (auto simp: simps)
  next
    case (Lact la)
      then show ?thesis using facts proof (cases la)
        case (lInnerPosts uid p)
          then have o: "⋀nid. owner s nid = owner s1 nid"
                and n: "⋀nid. post s nid = post s1 nid"
                and nids: "postIDs s = postIDs s1"
                and vis: "vis s = vis s1"
                and fu: "⋀uid'. friendIDs s uid' = friendIDs s1 uid'"
                and e: "e_listInnerPosts s uid p ⟷ e_listInnerPosts s1 uid p"
            using ss1 unfolding eqButUID_def l_defs by auto
          have "listInnerPosts s uid p = listInnerPosts s1 uid p"
            unfolding listInnerPosts_def o n nids vis fu ..
          with e show ?thesis using Lact lInnerPosts step step1 by auto
      qed (auto simp add: simps)
  next
    case (Uact ua) then show ?thesis using facts by (cases ua) (auto simp add: simps)
  next
    case (Dact da) then show ?thesis using facts by (cases da) (auto simp add: simps)
  qed
qed


lemma eqButUID_step_γ:
assumes ss1: "eqButUID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and φ: "φ (Trans s1 a ou1 s1') ⟷ φ (Trans s a ou s')"
shows "γ (Trans s a ou s') = γ (Trans s1 a ou1 s1')"
using assms eqButUID_step_γ_out[OF assms] eqButUID_step_γ_out[OF _ step1 step]
by (auto intro: eqButUID_sym)


end

end
ad>

Theory Outer_Friend_Receiver

theory Outer_Friend_Receiver
  imports
    "Outer_Friend_Receiver_Value_Setup"
    "Bounded_Deducibility_Security.Compositional_Reasoning"
begin

subsubsection ‹Declassification bound›

(* We verify the following:
   Given an arbitrary but fixed user UID at node AID (who is not an observer) and a set of
   observers at each network node, the observers may learn about the *occurrence* of remote
   friendship actions of UID (because network traffic is assumed to be observable), but they
   learn nothing about the *content* of those actions (who was added or deleted as a friend)
   beyond public knowledge (friendship addition and deletion occur alternatingly),
   except if the action adds or deletes one of the observers themselves as friend.
*)

context OuterFriendReceiver
begin

fun T :: "(state,act,out) trans ⇒ bool"
where "T trn = False"

text ‹For each user ‹uid› at this receiver node ‹AID'›, the remote friendship updates with
the fixed user ‹UID› at the issuer node ‹AID› form an alternating sequence of friending and unfriending.

Note that actions involving remote users who are observers do not produce secret values;
instead, those actions are observable, and the property we verify does not protect their
confidentiality.

Moreover, there is no declassification trigger on the receiver side, so term‹OVal› values
are never produced by receiver nodes, only by the issuer node.›

definition friendsOfUID :: "state ⇒ userID set" where
  "friendsOfUID s = {uid. (AID,UID) ∈∈ recvOuterFriendIDs s uid ∧ uid ∉ UIDs AID'}"

fun validValSeq :: "value list ⇒ userID set ⇒ bool" where
  "validValSeq [] _ = True"
| "validValSeq (FrVal aid uid True # vl) uids ⟷ uid ∉ uids ∧ aid = AID' ∧ uid ∉ UIDs AID' ∧ validValSeq vl (insert uid uids)"
| "validValSeq (FrVal aid uid False # vl) uids ⟷ uid ∈ uids ∧ aid = AID' ∧ uid ∉ UIDs AID' ∧ validValSeq vl (uids - {uid})"
| "validValSeq (OVal ov # vl) uids ⟷ False"

abbreviation "validValSeqFrom vl s ≡ validValSeq vl (friendsOfUID s)"

text ‹Observers may learn about the occurrence of
remote friendship actions (by observing network traffic), but not their content;
remote friendship actions at a receiver node ‹AID'› can be replaced by different actions
involving different users of that node (who are not observers)
without affecting the observations.›

inductive BC :: "value list ⇒ value list ⇒ bool"
where
  BC_Nil[simp,intro]: "BC [] []"
| BC_FrVal[intro]:
    "BC vl vl1 ⟹ uid' ∉ UIDs AID' ⟹ BC (FrVal aid uid st # vl) (FrVal AID' uid' st' # vl1)"

definition "B vl vl1 ≡ BC vl vl1 ∧ validValSeqFrom vl1 istate"


lemma BC_Nil_Nil: "BC vl vl1 ⟹ vl1 = [] ⟷ vl = []"
by (induction rule: BC.induct) auto

lemma BC_id: "validValSeq vl uids ⟹ BC vl vl"
by (induction rule: validValSeq.induct) auto

lemma BC_append: "BC vl vl1 ⟹ BC vl' vl1' ⟹ BC (vl @ vl') (vl1 @ vl1')"
by (induction rule: BC.induct) auto


sublocale BD_Security_IO where
istate = istate and step = step and
φ = φ and f = f and γ = γ and g = g and T = T and B = B
done


subsubsection ‹Unwinding proof›

definition Δ0 :: "state ⇒ value list ⇒ state ⇒ value list ⇒ bool" where
"Δ0 s vl s1 vl1 ≡ BC vl vl1 ∧ eqButUID s s1 ∧ validValSeqFrom vl1 s1"

lemma istate_Δ0:
assumes B: "B vl vl1"
shows "Δ0 istate vl istate vl1"
using assms unfolding Δ0_def B_def
by auto

lemma friendsOfUID_cong:
assumes "recvOuterFriendIDs s = recvOuterFriendIDs s'"
shows "friendsOfUID s = friendsOfUID s'"
using assms unfolding friendsOfUID_def by auto

lemma friendsOfUID_step_not_UID:
assumes "uid ≠ UID ∨ aid ≠ AID ∨ uid' ∈ UIDs AID'"
shows "friendsOfUID (receiveCreateOFriend s aid sp uid uid') = friendsOfUID s"
and "friendsOfUID (receiveDeleteOFriend s aid sp uid uid') = friendsOfUID s"
using assms unfolding friendsOfUID_def by (auto simp: com_defs)

lemma friendsOfUID_step_Create_UID:
assumes "uid' ∉ UIDs AID'"
shows "friendsOfUID (receiveCreateOFriend s AID sp UID uid') = insert uid' (friendsOfUID s)"
using assms unfolding friendsOfUID_def by (auto simp: com_defs)

lemma friendsOfUID_step_Delete_UID:
assumes "e_receiveDeleteOFriend s AID sp UID uid'"
and rs: "reach s"
shows "friendsOfUID (receiveDeleteOFriend s AID sp UID uid') = friendsOfUID s - {uid'}"
using assms reach_distinct_friends_reqs(4) unfolding friendsOfUID_def by (auto simp: com_defs)

lemma step_validValSeqFrom:
assumes step: "step s a = (ou, s')"
and rs: "reach s"
and c: "consume (Trans s a ou s') vl vl'" (is "consume ?trn vl vl'")
and vVS: "validValSeqFrom vl s"
shows "validValSeqFrom vl' s'"
proof cases
  assume "φ ?trn"
  moreover then obtain v where "vl = v # vl'" using c by (cases vl, auto simp: consume_def)
  ultimately show ?thesis using assms
    by (elim φ.elims) (auto simp: consume_def friendsOfUID_step_Create_UID friendsOfUID_step_Delete_UID)
next
  assume nφ: "¬φ ?trn"
  then have vl': "vl' = vl" using c by (auto simp: consume_def)
  then show ?thesis using vVS step proof (cases a)
    case (Sact sa) then show ?thesis using assms vl' by (cases sa) (auto simp: s_defs cong: friendsOfUID_cong) next
    case (Cact ca) then show ?thesis using assms vl' by (cases ca) (auto simp: c_defs cong: friendsOfUID_cong) next
    case (Dact da) then show ?thesis using assms vl' by (cases da) (auto simp: d_defs cong: friendsOfUID_cong) next
    case (Uact ua) then show ?thesis using assms vl' by (cases ua) (auto simp: u_defs cong: friendsOfUID_cong) next
    case (COMact ca)
      then show ?thesis using assms vl' nφ proof (cases ca)
        case (comReceiveCreateOFriend aid sp uid uid')
          then show ?thesis using COMact assms nφ by (auto simp: friendsOfUID_step_not_UID consume_def)
      next
        case (comReceiveDeleteOFriend aid sp uid uid')
          then show ?thesis using COMact assms nφ by (auto simp: friendsOfUID_step_not_UID consume_def)
      qed (auto simp: com_defs cong: friendsOfUID_cong)
  qed auto
qed



lemma unwind_cont_Δ0: "unwind_cont Δ0 {Δ0}"
proof(rule, simp)
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Δ0: "Δ0 s vl s1 vl1"
  then have rs: "reach s" and ss1: "eqButUID s s1" and BC: "BC vl vl1"
        and vVS1: "validValSeqFrom vl1 s1"
    using reachNT_reach unfolding Δ0_def by auto
  show "iaction Δ0 s vl s1 vl1 ∨
        ((vl = [] ⟶ vl1 = []) ∧ reaction Δ0 s vl s1 vl1)" (is "?iact ∨ (_ ∧ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      assume step: "step s a = (ou, s')" and T: "¬ T ?trn" and c: "consume ?trn vl vl'"
      show "match Δ0 s s1 vl1 a ou s' vl' ∨ ignore Δ0 s s1 vl1 a ou s' vl'" (is "?match ∨ ?ignore")
      proof cases
        assume φ: "φ ?trn"
        with BC c have "?match" proof (cases rule: BC.cases)
          case (BC_FrVal vl'' vl1'' uid' aid uid st st')
            then show ?thesis proof (cases st')
              case True
                let ?a1 = "COMact (comReceiveCreateOFriend AID (serverPass s AID) UID uid')"
                let ?ou1 = "outOK"
                let ?s1' = "receiveCreateOFriend s1 AID (serverPass s AID) UID uid'"
                let ?trn1 = "Trans s1 ?a1 ?ou1 ?s1'"
                have c1: "consume ?trn1 vl1 vl1''" and "vl' = vl''" and "f ?trn = FrVal AID' uid st"
                  using φ c BC_FrVal True by (auto elim: φ.elims simp: consume_def)
                moreover then have a: "a = COMact (comReceiveCreateOFriend AID (serverPass s AID) UID uid)
                                     ∨ a = COMact (comReceiveDeleteOFriend AID (serverPass s AID) UID uid)"
                               and ou: "ou = outOK"
                               and IDs: "IDsOK s [] [] [(AID,[])] []"
                               and uid: "uid ∉ UIDs AID'"
                  using φ step rs by (auto elim!: φ.elims split: prod.splits simp: com_defs)
                moreover have step1: "step s1 ?a1 = (?ou1, ?s1')"
                  using IDs vVS1 BC_FrVal True ss1 by (auto simp: com_defs eqButUID_def friendsOfUID_def)
                moreover then have "validValSeqFrom vl1'' ?s1'"
                  using vVS1 rs1 c1 by (intro step_validValSeqFrom[OF step1]) auto
                moreover have "eqButUID s' ?s1'"
                  using ss1 recvOFriend_eqButUID[OF step rs a uid]
                  using recvOFriend_eqButUID[OF step1 rs1, of "serverPass s AID" uid'] BC_FrVal(4)
                  by (auto intro: eqButUID_sym eqButUID_trans)
                moreover have "γ ?trn = γ ?trn1" and "g ?trn = g ?trn1"
                  using BC_FrVal a ou uid by (auto simp: com_defs)
                ultimately show "?match"
                  using BC_FrVal by (intro matchI[of s1 ?a1 ?ou1 ?s1' vl1 vl1'']) (auto simp: Δ0_def)
            next
              case False
                let ?a1 = "COMact (comReceiveDeleteOFriend AID (serverPass s AID) UID uid')"
                let ?ou1 = "outOK"
                let ?s1' = "receiveDeleteOFriend s1 AID (serverPass s AID) UID uid'"
                let ?trn1 = "Trans s1 ?a1 ?ou1 ?s1'"
                have c1: "consume ?trn1 vl1 vl1''" and "vl' = vl''" and "f ?trn = FrVal AID' uid st"
                  using φ c BC_FrVal False by (auto elim: φ.elims simp: consume_def)
                moreover then have a: "a = COMact (comReceiveCreateOFriend AID (serverPass s AID) UID uid)
                                     ∨ a = COMact (comReceiveDeleteOFriend AID (serverPass s AID) UID uid)"
                               and ou: "ou = outOK"
                               and IDs: "IDsOK s [] [] [(AID,[])] []"
                               and uid: "uid ∉ UIDs AID'"
                  using φ step rs by (auto elim!: φ.elims split: prod.splits simp: com_defs)
                moreover have step1: "step s1 ?a1 = (?ou1, ?s1')"
                  using IDs vVS1 BC_FrVal False ss1 by (auto simp: com_defs eqButUID_def friendsOfUID_def)
                moreover then have "validValSeqFrom vl1'' ?s1'"
                  using vVS1 rs1 c1 by (intro step_validValSeqFrom[OF step1]) auto
                moreover have "eqButUID s' ?s1'"
                  using ss1 recvOFriend_eqButUID[OF step rs a uid]
                  using recvOFriend_eqButUID[OF step1 rs1, of "serverPass s AID" uid'] BC_FrVal(4)
                  by (auto intro: eqButUID_sym eqButUID_trans)
                moreover have "γ ?trn = γ ?trn1" and "g ?trn = g ?trn1"
                  using BC_FrVal a ou uid by (auto simp: com_defs)
                ultimately show "?match"
                  using BC_FrVal by (intro matchI[of s1 ?a1 ?ou1 ?s1' vl1 vl1'']) (auto simp: Δ0_def)
            qed
        qed (auto simp: consume_def)
        then show "?match ∨ ?ignore" ..
      next
        assume nφ: "¬φ ?trn"
        then have vl': "vl' = vl" using c by (auto simp: consume_def)
        obtain ou1 s1' where step1: "step s1 a = (ou1, s1')" by (cases "step s1 a")
        let ?trn1 = "Trans s1 a ou1 s1'"
        show "?match ∨ ?ignore"
        proof (cases "∀uID'. uID' ∉ UIDs AID' ⟶
                             a ≠ COMact (comReceiveCreateOFriend AID (serverPass s1 AID) UID uID') ∧
                             a ≠ COMact (comReceiveDeleteOFriend AID (serverPass s1 AID) UID uID')")
          case True
            then have nφ1: "¬φ ?trn1" using step1 by (auto elim!: φ.elims simp: com_defs)
            have "?match" using step1 unfolding vl' proof (intro matchI[of s1 a ou1 s1' vl1 vl1])
              show c1: "consume ?trn1 vl1 vl1" using nφ1 by (auto simp: consume_def)
              show "Δ0 s' vl s1' vl1" using BC unfolding Δ0_def proof (intro conjI)
                show "eqButUID s' s1'" using eqButUID_step[OF ss1 step step1 rs rs1] .
                show "validValSeqFrom vl1 s1'"
                  using c1 rs1 vVS1 by (intro step_validValSeqFrom[OF step1]) auto
              qed auto
              show "γ ?trn = γ ?trn1" using ss1 rs rs1 step step1 True nφ nφ1
                by (intro eqButUID_step_γ) auto
            next
              assume "γ ?trn"
              then have "ou = ou1" using nφ nφ1 by (intro eqButUID_step_γ_out[OF ss1 step step1]) auto
              then show "g ?trn = g ?trn1" by (cases a) auto
            qed auto
            then show "?match ∨ ?ignore" ..
        next
          case False
            with nφ have "?ignore"
              using UID_UIDs BC step ss1 vVS1 unfolding vl'
              by (intro ignoreI) (auto simp: Δ0_def split: prod.splits)
            then show "?match ∨ ?ignore" ..
        qed
      qed
    qed
    with BC show ?thesis by (cases rule: BC.cases) auto
  qed
qed



definition Gr where
"Gr =
 {
 (Δ0, {Δ0})
 }"


theorem secure: secure
apply (rule unwind_decomp_secure_graph[of Gr Δ0])
unfolding Gr_def
(* apply (simp, smt insert_subset order_refl) *)
using
istate_Δ0 unwind_cont_Δ0
unfolding Gr_def by (auto intro: unwind_cont_mono)


end

end
d>

Theory Outer_Friend_Network

theory Outer_Friend_Network
imports
  "../API_Network"
  "Issuer/Outer_Friend_Issuer"
  "Receiver/Outer_Friend_Receiver"
  "BD_Security_Compositional.Composing_Security_Network"
begin

subsection ‹Confidentiality for the N-ary composition›

locale OuterFriendNetwork = OuterFriend + Network +
assumes AID_AIDs: "AID ∈ AIDs"
begin

sublocale Issuer: OuterFriendIssuer UIDs AID UID using UID_UIDs by unfold_locales

abbreviation φ :: "apiID ⇒ (state, act, out) trans ⇒ bool"
where "φ aid trn ≡ (if aid = AID then Issuer.φ trn else OuterFriendReceiver.φ UIDs AID UID aid trn)"

abbreviation f :: "apiID ⇒ (state, act, out) trans ⇒ value"
where "f aid trn ≡ (if aid = AID then Issuer.f trn else OuterFriendReceiver.f aid trn)"

abbreviation γ :: "apiID ⇒ (state, act, out) trans ⇒ bool"
where "γ aid trn ≡ (if aid = AID then Issuer.γ trn else OuterFriendReceiver.γ UIDs aid trn)"

abbreviation g :: "apiID ⇒ (state, act, out) trans ⇒ obs"
where "g aid trn ≡ (if aid = AID then Issuer.g trn else OuterFriendReceiver.g UIDs AID UID aid trn)"

abbreviation T :: "apiID ⇒ (state, act, out) trans ⇒ bool"
where "T aid trn ≡ False"

abbreviation B :: "apiID ⇒ value list ⇒ value list ⇒ bool"
where "B aid vl vl1 ≡ (if aid = AID then Issuer.B vl vl1 else OuterFriendReceiver.B UIDs AID UID aid vl vl1)"

fun comOfV where
  "comOfV aid (FrVal aid' uid' st) = (if aid ≠ AID then Recv else (if aid' ≠ aid then Send else Internal))"
| "comOfV aid (OVal ov) = Internal"

fun tgtNodeOfV where
  "tgtNodeOfV aid (FrVal aid' uid' st) = (if aid = AID then aid' else AID)"
| "tgtNodeOfV aid (OVal ov) = AID"

abbreviation "syncV aid1 v1 aid2 v2 ≡ (v1 = v2)"

sublocale Net: BD_Security_TS_Network_getTgtV
where istate = "λ_. istate" and validTrans = validTrans and srcOf = "λ_. srcOf" and tgtOf = "λ_. tgtOf"
  and nodes = AIDs and comOf = comOf and tgtNodeOf = tgtNodeOf
  and sync = sync and φ = φ and f = f and γ = γ and g = g and T = T and B = B
  and comOfV = comOfV and tgtNodeOfV = tgtNodeOfV and syncV = syncV
  and comOfO = comOfO and tgtNodeOfO = tgtNodeOfO and syncO = syncO (*and cmpO = cmpO*)
  and source = AID and getTgtV = id
proof (unfold_locales, goal_cases)
  case (1 aid trn)
    interpret Receiver: OuterFriendReceiver UIDs AID UID aid by unfold_locales
    from 1 show ?case by (cases trn) (auto elim!: Issuer.φE Receiver.φ.elims split: prod.splits)
next
  case (2 aid trn)
    interpret Receiver: OuterFriendReceiver UIDs AID UID aid by unfold_locales
    from 2 show ?case by (cases trn) (auto elim!: Issuer.φE Receiver.φ.elims)
next
  case (3 aid trn)
    interpret Receiver: OuterFriendReceiver UIDs AID UID aid by unfold_locales
    from 3 show ?case by (cases "(aid,trn)" rule: tgtNodeOf.cases) (auto)
next
  case (4 aid trn)
    interpret Receiver: OuterFriendReceiver UIDs AID UID aid by unfold_locales
    from 4 show ?case by (cases "(aid,trn)" rule: tgtNodeOf.cases) auto
next
  case (5 aid1 trn1 aid2 trn2)
    interpret Receiver1: OuterFriendReceiver UIDs AID UID aid1 by unfold_locales
    interpret Receiver2: OuterFriendReceiver UIDs AID UID aid2 by unfold_locales
    from 5 show ?case by (elim sync_cases) (auto simp: com_defs)
next
  case (6 aid1 trn1 aid2 trn2)
    interpret Receiver1: OuterFriendReceiver UIDs AID UID aid1 by unfold_locales
    interpret Receiver2: OuterFriendReceiver UIDs AID UID aid2 by unfold_locales
    from 6 show ?case by (elim sync_cases) (auto)
next
  case (7 aid1 trn1 aid2 trn2)
    interpret Receiver1: OuterFriendReceiver UIDs AID UID aid1 by unfold_locales
    interpret Receiver2: OuterFriendReceiver UIDs AID UID aid2 by unfold_locales
    from 7 show ?case
      using Issuer.COMact_open[of "srcOf trn1" "actOf trn1" "outOf trn1" "tgtOf trn1"]
      using Issuer.COMact_open[of "srcOf trn2" "actOf trn2" "outOf trn2" "tgtOf trn2"]
      by (elim sync_cases) auto
next
  case (8 aid1 trn1 aid2 trn2)
    interpret Receiver1: OuterFriendReceiver UIDs AID UID aid1 by unfold_locales
    interpret Receiver2: OuterFriendReceiver UIDs AID UID aid2 by unfold_locales
    assume "comOf aid1 trn1 = Send" "comOf aid2 trn2 = Recv" "syncO aid1 (g aid1 trn1) aid2 (g aid2 trn2)"
           "φ aid1 trn1 ⟹ φ aid2 trn2 ⟹ f aid1 trn1 = f aid2 trn2"
           "validTrans aid1 trn1" "validTrans aid2 trn2"
    then show ?case using emptyUserID_not_UIDs
      by (elim syncO_cases; cases trn1; cases trn2)
         (auto simp: Issuer.g_simps Receiver1.g_simps Receiver2.g_simps simp: com_defs)
next
  case (9 aid trn)
    interpret Receiver: OuterFriendReceiver UIDs AID UID aid by unfold_locales
    from 9 show ?case by (cases "(aid,trn)" rule: tgtNodeOf.cases) (auto)
next
  case (10 aid trn)
    interpret Receiver: OuterFriendReceiver UIDs AID UID aid by unfold_locales
    from 10 show ?case using AID_AIDs by (auto elim!: Receiver.φ.elims)
next
  case (11 vSrc nid vn) then show ?case by (cases vSrc) auto
next
  case (12 vSrc nid vn) then show ?case by (cases vSrc) auto
qed

context
fixes AID' :: apiID
assumes AID': "AID' ∈ AIDs - {AID}"
begin

interpretation Receiver: OuterFriendReceiver UIDs AID UID AID' by unfold_locales

lemma Issuer_BC_Receiver_BC:
assumes "Issuer.BC vl vl1"
shows "Receiver.BC (Net.projectSrcV AID' vl) (Net.projectSrcV AID' vl1)"
using assms by (induction rule: Issuer.BC.induct) auto

lemma Collect_setminus: "Collect P - A = {u. u ∉ A ∧ P u}"
by auto

lemma Issuer_vVS_Receiver_vVS:
assumes "Issuer.validValSeq vl auidl"
shows "Receiver.validValSeq (Net.projectSrcV AID' vl) {uid. (AID',uid) ∈∈ auidl}"
using assms AID'
proof (induction vl auidl rule: Issuer.validValSeq.induct)
  case (2 aid uid vl auidl)
  then show ?case by (auto simp: insert_Collect Collect_setminus, linarith, smt Collect_cong)
next
  case (3 aid uid vl auidl)
  then show ?case by (auto simp: insert_Collect Collect_setminus; smt Collect_cong)
qed auto

lemma Issuer_B_Receiver_B:
assumes "Issuer.B vl vl1"
shows "Receiver.B (Net.projectSrcV AID' vl) (Net.projectSrcV AID' vl1)"
using assms Issuer_BC_Receiver_BC Issuer_vVS_Receiver_vVS[of _ "[]"]
unfolding Issuer.B_def Issuer.BO_def Receiver.B_def Receiver.friendsOfUID_def
by (auto simp: istate_def intro!: Receiver.BC_append Receiver.BC_id, blast dest: Issuer.validValSeq_prefix)

end


sublocale BD_Security_TS_Network_Preserve_Source_Security_getTgtV
where istate = "λ_. istate" and validTrans = validTrans and srcOf = "λ_. srcOf" and tgtOf = "λ_. tgtOf"
  and nodes = AIDs and comOf = comOf and tgtNodeOf = tgtNodeOf
  and sync = sync and φ = φ and f = f and γ = γ and g = g and T = T and B = B
  and comOfV = comOfV and tgtNodeOfV = tgtNodeOfV and syncV = syncV
  and comOfO = comOfO and tgtNodeOfO = tgtNodeOfO and syncO = syncO (*and cmpO = cmpO*)
  and source = AID and getTgtV = id
using AID_AIDs Issuer_B_Receiver_B Issuer.secure
by unfold_locales auto

theorem secure: "secure"
proof (intro preserve_source_secure ballI)
  fix aid
  interpret Receiver: OuterFriendReceiver UIDs AID UID aid by unfold_locales
  assume "aid ∈ AIDs - {AID}"
  then show "Net.lsecure aid" using Receiver.secure by auto
qed

end

end

Theory Outer_Friend_All

theory Outer_Friend_All
imports Outer_Friend_Network
begin


end